Almathera Ten Pack 3: CDPD 3/Almathera Ten on Ten - Disc 3: CDPD3.iso/scope/201-220/scopedisk202/bbbbs2/rexx/bbbbs.baud

Text File | 1995-03-19 | 117KB | 4,296 lines

/***         $VER: BBBBS.baud  version 2.0    2 Mar 1991  ()           ***/
/***  copyright 1990 Richard Lee Stockton * FREELY DISTRIBUTABLE *     ***/

/*** BBS.baud   -   A sorta-full-featured BBS in rexx for Baudbandit   ***/
/*** based on 'Answer.baud'. Thanks to Greg Cunningham for BaudBandit! ***/

/*** 'BBS:Information/BBBBS.doc' & rexx:bbsSYSOP.rexx for install info ***/


/* If the QuickSortPort not found then try to run setup.rexx . */

IF ~show('P','QuickSortPort') THEN CALL setup.rexx();

/* If the QuickSortPort is STILL not found then we gotta quit. */

IF ~show('P','QuickSortPort') THEN SIGNAL DONE2


/*-------------- VARIABLES ----------------------------------------------*/

bbsprefs.    = 0  /* start with all prefs OFF */
lastread.    = 0
dirnum       = 1
linesperpage = 19
level        = 0
lastread.    = 0
totwrit.     = 0
lastbrowse   = 0
warnings     = 0
winnings     = 0
nonstop      = 0
newfilesdate = ''
newpassword  = ''
replysubj    = ''
msgdir       = 1
menuflag     = 1
logonflag    = 1
data.        = ''

/*-------------- TEXT ---------------------------------------------------*/

text.   = ''                 /* This is the user data structure by line */
text.1  = '   Full Name'
text.2  = '      Street'
text.3  = 'City, ST Zip'
text.4  = ' Voice Phone'
text.5  = '    Password'
text.6  = '    Protocol'
text.7  = 'LinesPerPage'
text.8  = ' Preferences'
text.9  = '    Computer'
text.10 = '   Interests'
text.11 = 'Session Time'
text.12 = 'FirstSession'
text.13 = 'Last Session'
text.14 = '      UpLoad'
text.15 = '    Download'
text.16 = '   Last File'
text.17 = 'Ratio  Email'
text.18 = '    Winnings'
text.19 = '       Usage'
text.20 = '       Level'
text.21 = 'Exclude DIRS'
text.22 = '   Msgs Read'
text.23 = '   Msgs Writ'


/* page control codes */

lineup='1B'x'M'


/* try to trap everything */

SIGNAL ON BREAK_C
OPTIONS RESULTS
bps=getbaudrate();
SIGNAL ON BREAK_E
SIGNAL ON SYNTAX
SIGNAL ON FAILURE
OPTIONS FAILAT 25


/*--------------- SETUP -----------------------------------------*/

name=''
CR='0D'x
LF='0A'x

SAY '       - Baud Bandit Bulletin Board System from Gramma Software -'CR

arg='s:CONFIG.BBS'
IF ~EXISTS(arg) THEN arg='BBS:BBS_TEXT/CONFIG.BBS'
IF readlines(arg 1) THEN
  DO
    MSG 's:CONFIG.BBS and BBS:BBS/CONFIG.BBS are both missing!'
    SIGNAL DONE2
  END
compos=POS('/*',lynes.1)
IF compos>0 THEN lynes.1=LEFT(lynes.1,compos-1)
bbsname            = STRIP(lynes.1)
sysop              = WORD(lynes.2,1)
compos=POS('/*',lynes.3)
IF compos>0 THEN lynes.3=LEFT(lynes.3,compos-1)
exclusionlist      = STRIP(lynes.3)
bbsdevice          = WORD(lynes.4,1)
sysoplevel         = WORD(lynes.5,1)
bbspath            = WORD(lynes.6,1)
IF ~EXISTS(bbspath) THEN
  DO
    MSG bbspath 'does not exist!'
    SIGNAL DONE2
  END
testchar=RIGHT(bbspath,1)
IF testchar~='/' & testchar~=':' THEN bbspath=bbspath'/'
CALL SETCLIP('BBS_path',bbspath)

msgpath            = WORD(lynes.7,1)
IF ~EXISTS(msgpath) THEN
  DO
    MSG msgpath 'does not exist!'
    SIGNAL DONE2
  END
testchar=RIGHT(msgpath,1)
IF testchar~='/' & testchar~=':' THEN msgpath=msgpath'/'
msgpath=msgpath'MSG'

libpath            = WORD(lynes.8,1)
IF ~EXISTS(libpath) THEN
  DO
    MSG libpath 'does not exist!'
    SIGNAL DONE2
  END
testchar=RIGHT(libpath,1)
IF testchar~='/' & testchar~=':' THEN libpath=libpath'/'

spellpath          = WORD(lynes.9,1)
IF bbsprefs.5 & ~EXISTS(spellpath) THEN
  DO
    MSG spellpath 'does not exist!'
    bbsprefs.5=0
  END

/* expansion config would go here, lines 10-11 */

SYSTEM_SPACE_LIMIT = WORD(lynes.12,1)
maxidle            = WORD(lynes.13,1)
maxtime            = WORD(lynes.14,1)
maxbps             = WORD(lynes.15,1)
IF ~DATATYPE(maxbps,'N') THEN maxbps=2400
DO i=16 TO 30
  j=i-15
  bbsprefs.j=STRIP(WORD(lynes.i,1))
END
IF bbsprefs.10 THEN scratch=bbspath'Scratch'
ELSE scratch='RAM:Scratch'
CALL MAKEDIR(scratch)

SAY 'The ARexx portions of this software are copyright 1990 Richard Lee Stockton'CR

/** open log file */
logfile = bbspath'Logs/log.'DATE('S')    /* daily logs */
IF ~OPEN('log',logfile,'A') THEN
  DO
    IF ~OPEN('log',logfile,'W') THEN
      DO
        MSG 'failed to open log file'
        SIGNAL DONE2
     END
  END

/* open printer? */
IF bbsprefs.3 THEN
  DO
    IF ~OPEN(p,'PRT:','W') THEN
      DO
        CALL WRITELN('log','failed to open printer.')
        bbsprefs.3=0
      END
  END

/*--------------- LOGIN -----------------------------------------*/

Remote ON
CALL colors(1)
Timeout 120
CALL checkdcd();

msg.=''
IF readopen(bbspath'Lists/Conferences') THEN
  DO
    DO i=1
      line=READLN(f)
      IF line='END' THEN BREAK;
      IF EOF(f) THEN BREAK;
      num=WORD(line,1)
      IF DATATYPE(num,'N') THEN msg.num=WORD(line,2)
    END
    CALL CLOSE(f)
  END

excuses.=''

SAY '        - FREELY DISTRIBUTABLE as long as this notice remains -'CR
SAY CR
SAY CR
SAY 'Setting up, please wait...'CR
SAY CR

files.=''
IF readopen(bbspath'Lists/Files') THEN
  DO
    DO i=1
      line=READLN(f)
      IF EOF(f) THEN BREAK;
      num=WORD(line,1)
      line=DELWORD(line,1,1)
      IF DATATYPE(num,'N') THEN files.num=line
    END
    files.0=i-1
    CALL CLOSE(f)
  END

courtesy=''
IF EXISTS(bbspath'Lists/Courtesy') THEN
  DO
    IF readopen(bbspath'Lists/Courtesy') THEN
      DO
        DO i=1
          line=READLN(f)
          IF EOF(f) THEN BREAK;
          courtesy=courtesy line
        END
        CALL CLOSE(f)
      END
  END

dirs.=''
IF readopen(bbspath'Lists/Libraries') THEN
  DO
    DO i=1
      line=READLN(f)
      IF line='END' | EOF(f) THEN LEAVE i
      num=WORD(line,1)
      IF DATATYPE(num,'N') THEN dirs.num=STRIP(WORD(line,2))
    END
    CALL CLOSE(f)
  END

CALL checkdcd()
CALL loaduserlist();


/** Identify (title) message */
IF EXISTS(bbspath'BBS_TEXT/HELLO') THEN
  DO
    SAY CR
    SAY CR
    SAY CR
    arg=bbspath'BBS_TEXT/HELLO'
    CALL readlines(arg 1)
    CALL seelines();
  END
SAY CR

Status Vers
SAY 'Running on' Result 'at' bps 'baud.'CR
SAY CR
Stat 'Z'
CALL checkdcd();
MSG pen3'Courtesy List:'def
MSG courtesy

/** Ask for name */
name=''
DO count=1 TO 3
  name=getinput(1 0 'Please enter name: ')
  name=SPACE(name,1,'_')
  IF name='NEW' THEN LEAVE count;
  IF name~='' THEN
    DO
      IF FIND(userlist,name)>0 THEN LEAVE count
      IF FIND(exclusionlist,name)>0 THEN
        DO
          SAY 'Sorry, that is a reserved name.'CR
          name=''
        END
      IF bbsprefs.7 | FIND(courtesy,name)>0 THEN
        DO
          SAY CR
          SAY 'Welcome' name'!'CR
          SAY 'You will be automatically validated after you enter your user info.'CR
          SAY CR
          LEAVE count
        END
    END
  IF count<3 THEN SAY 'New Users please enter NEW to apply for validation.'CR
END
IF count>3 THEN SIGNAL DONE
line=left(name,16,' ') 'logged in  at' time('C') date('W') date()
CALL send2log(line);
CALL checkUser()
prevcaller=''
prevcaller=GETCLIP('BBS_lastcaller')
IF prevcaller~='' THEN CALL SETCLIP('BBS_prevcaller',prevcaller)
city=TRANSLATE(data.3,'     ','+-.*/')
DO i=WORDS(city) TO 1 BY -1
  IF DATATYPE(WORD(city,i),'N') THEN city=STRIP(DELWORD(city,i,1))
  IF UPPER(WORD(city,i))='USA' THEN city=STRIP(DELWORD(city,i,1))
END
city=SPACE(city,1)
CALL SETCLIP('BBS_lastcaller',name city'  'TIME('C') DATE())
CALL SETCLIP('BBS_level',level)
Beep 700
CALL DELAY(14)
Beep
CALL postuser(0);


Timeout maxidle         /* max idle time at prompts */

/** Opening Display after logon. Seen by all Users ONCE A DAY. It first  **/
/** looks for a unique yearly data (ie, WELCOME.0704), then daily data   **/
/** (ie, WELCOME.Fri), and finally a simple, everyday 'WELCOME' datafile **/

IF DATE('I')>lastondate THEN
  DO
    arg=bbspath'BBS_TEXT/WELCOME.'RIGHT(DATE('S'),4)
    IF ~EXISTS(arg) THEN
      DO
        arg=bbspath'BBS_TEXT/WELCOME.'LEFT(DATE('W'),3)
        IF ~EXISTS(arg) THEN arg=bbspath'BBS_TEXT/WELCOME'
      END
    IF EXISTS(arg) THEN
      DO
        SAY CR
        CALL showtext(arg)
        nonstop=0
      END
  END
SAY CR

/** Save old data directory */
Status DataDir
startdir=result

IF bbsprefs.1 THEN
  DO
    CALL doGrin();
    CALL Moon.rexx();
    CALL Time.rexx();
    SAY CR
  END
CALL sortlibraries();

/* Get current protocol */
Status Trans
protocol = RESULT
CALL TIME('R')

CALL logonstats();
CALL newinfo(1);
logonflag=0
CALL readmail(0)
IF level<99 & level>sysoplevel THEN
  DO
    SAY CR
    CALL showtext(bbspath'Email/'sysop'/NEW_FILES')
    SAY CR
    CALL showtext(bbspath'Email/'sysop'/NEW_USERS')
  END
CALL showmarked()
CALL setdir(libpath||dirs.1)


/*-------------------------- MAIN ---------------------------------------*/

IF menu~='ALL' THEN menu='MAIN'

RESTART:
waitchar=''
string=''
IF level<1 THEN menu='NEW'
DO WHILE(opt~='G')
  go=0
  DO WHILE(~go)
    IF waitchar='' | waitchar='?' THEN
      DO
        commands='cghiqswxyz!#'
        IF level>0  THEN commands='bcdefghijlmnoprstuvwxyz!$#.'
        IF level>sysoplevel THEN commands=commands'k%^()='
        IF level=99 THEN commands=commands'@&-'
        commands=commands'?'
        IF menuflag | waitchar='?' | string='?' THEN
          DO
            opt='MENU'
            arg=''
            CALL postuser(1);
            CALL menus();
          END
        ELSE SAY pen3'COMMANDS:'def commands||CR
      END
    mins=(maxtime-TIME('E'))%60
    secs=TRUNC((maxtime-TIME('E'))//60)
    IF secs<10 THEN secs='0'secs
    SAY 'Time Remaining: ' mins':'secs||CR
    CALL checktime();
    line=''
    line=line||bak2' 'TIME('C')' 'def
    IF menu='ALL' | menu='FILE' THEN
      line=line pen3'FILE_LIBRARY:'plaindir||def
    ELSE IF menu='MSG' THEN line=line pen3'MESSAGES:'def
    ELSE line=line pen3'MAIN:'def
    OPTIONS PROMPT line' > '
    IF waitchar='' THEN PARSE PULL string' 'arg .
    ELSE PARSE VAR waitchar string' 'arg .
    CALL checkdcd();
    string=UPPER(STRIP(string))
    IF string='OFF' | string='BYE' THEN SIGNAL LOGOUT;
    waitchar=''
    warnings=0
    IF DATATYPE(string,'N') THEN
      DO
        dirnum=string
        CALL chdir2();
        CALL since();
      END
    opt=left(string,1)
    IF opt='G' THEN
      DO
        IF getinput(1 1 pen3'Logoff? (nY) > 'def)='N' THEN opt='?'
      END
    go=1    /* check for access */
    IF POS(opt,UPPER(commands))=0 & opt~='\' THEN go=0
  END
  CALL postuser(1);
  OPTIONS PROMPT 'Filename: '
  SELECT
    WHEN(opt='B') THEN CALL browse();
    WHEN(opt='C') THEN CALL editor('MAIL' sysop);
    WHEN(opt='D') THEN CALL dload();
    WHEN(opt='E') THEN CALL readmail(1);
    WHEN(opt='F') THEN IF menu~='ALL' THEN menu='FILE'
    WHEN(opt='H') THEN CALL help('MAIN');
    WHEN(opt='I') THEN CALL information();
    WHEN(opt='J') THEN CALL jump2rexx();
    WHEN(opt='K') THEN CALL killuser();
    WHEN(opt='L') THEN CALL list();
    WHEN(opt='M') THEN IF menu~='ALL' THEN menu='MSG'
    WHEN(opt='N') THEN CALL newfiles();
    WHEN(opt='O') THEN CALL otheruser();
    WHEN(opt='P') THEN CALL editor('MSG')
    WHEN(opt='R') THEN CALL readmessages();
    WHEN(opt='S') THEN CALL bbsSEARCH();
    WHEN(opt='T') THEN CALL chpro();
    WHEN(opt='U') THEN CALL uload(1);
    WHEN(opt='V') THEN CALL viewtext();
    WHEN(opt='W') THEN CALL showuserlist()
    WHEN(opt='X') THEN CALL switchmenuflag();
    WHEN(opt='Y') THEN CALL edituser();
    WHEN(opt='Z') THEN CALL counts();
    WHEN(opt='\') THEN CALL chat();
    WHEN(opt='!') THEN CALL yell();
    WHEN(opt='@') THEN CALL shell();
    WHEN(opt='#') THEN CALL switchcolors();
    WHEN(opt='$') THEN IF menu='ALL' THEN menu='MAIN'; ELSE menu='ALL'
    WHEN(opt='%') THEN CALL editnote();
    WHEN(opt='^') THEN CALL readlogs();
    WHEN(opt='&') THEN CALL sysED(1);
    WHEN(opt='-') THEN CALL edfilenote();
    WHEN(opt='(') THEN CALL filereport();
    WHEN(opt=')') THEN CALL mailreport();
    WHEN(opt='=') THEN CALL levelreport();
    WHEN(opt='.') THEN IF menu~='ALL' THEN menu='MAIN'
    WHEN(opt='?') & menuflag THEN CALL help('MAIN');
    OTHERWISE NOP
  END
END
SIGNAL LOGOUT
EXIT;       /* an extra margin of safety */


/*------------------------- FUNCTIONS ----------------------------------*/

showtext:
PARSE ARG arg .
IF EXISTS(arg) THEN
  DO
    CALL readlines(arg 1);
    CALL seelines();
    nonstop=0
    CALL waiting();
  END
RETURN;


doGrin:
CALL setdir(bbspath'rexxDoors')
CALL Grin_du_Jour.rexx();
SAY CR
RETURN;


send2log:
PARSE ARG sendline
CALL WRITELN('log',sendline)
IF bbsprefs.3 THEN CALL WRITELN(p,sendline)
RETURN;


killuser:
IF level<=sysoplevel THEN RETURN;
IF arg='' THEN
  DO
    OPTIONS PROMPT 'Username: '
    PARSE PULL arg .
  END
IF STRIP(arg)='' THEN RETURN;
arg=UPPER(arg)
arg=SPACE(STRIP(arg),1,'_')
IF getinput(1 1 'Really kill' arg'? (nY) > ')='N' THEN RETURN;
SAY 'Working...'lineup||CR
IF readlines(bbspath'Users/'arg 1) THEN SAY 'User not found.'CR
IF level<=lynes.20 THEN
  DO
    SAY '*** Tsk! Tsk!  Your level is not greater than' arg'.'CR
    CALL send2log('Tried to kill:' arg)
    RETURN;
  END
CALL DELETE(bbspath'Users/'arg)
IF EXISTS(bbspath'Email/'arg) THEN
  ADDRESS COMMAND 'DELETE >*' bbspath'Email/'arg 'ALL'
IF EXISTS(bbspath'EmailFiles/'arg) THEN
  ADDRESS COMMAND 'DELETE >*' bbspath'EmailFiles/'arg 'ALL'
CALL DELETE(bbspath'Lists/USERS')
CALL loaduserlist();
CALL send2log('Killed:' arg)
SAY 'User file, Email & EmailFiles for' arg 'have been deleted.'CR
RETURN;


menus:
SAY CR
IF menu='NEW' THEN
DO
  SAY pen6'     _________________'def||CR
  SAY pen6'  __/  'pen3'New User Menu'pen6'  \___'def||CR
  SAY pen6' |                        |'def||CR
  SAY pen6' |'def'   ['pen3'H'def']elp               'pen6'|'def||CR
  SAY pen6' |'def'   ['pen3'I'def']nfomation         'pen6'|'def||CR
  SAY pen6' |'def'   ['pen3'Y'def']our user data     'pen6'|'def||CR
  SAY pen6' |'def'   ['pen3'W'def']ho is here        'pen6'|'def||CR
  SAY pen6' |'def'   ['pen3'S'def']earch user list   'pen6'|'def||CR
  SAY pen6' |'def'   ['pen3'Z'def'] bbs statistics   'pen6'|'def||CR
  SAY pen6' |'def'   ['pen3'X'def'] toggle menus     'pen6'|'def||CR
  SAY pen6' |'def'   ['pen3'#'def'] toggle color     'pen6'|'def||CR
  SAY pen6' |'def'   ['pen3'!'def'] YELL for SYSOP   'pen6'|'def||CR
  SAY pen6' |'def'   ['pen3'C'def']omment to SYSOP   'pen6'|'def||CR
  SAY pen6' |'def'   ['pen3'G'def']oodbye (hangup)   'pen6'|'def||CR
  MSG pen6' |'def'   ['pen3'\'def'] Chat             'pen6'|'def
  SAY pen6' |________________________|'def||CR
END
ELSE IF menu='MSG' THEN
DO
    SAY pen6'       ____________'def||CR
    SAY pen6'  ____/  'pen3'Messages'pen6'  \_____'def||CR
    SAY pen6' |                       |'def||CR
    SAY pen6' |'def'   ['pen3'H'def']elp              'pen6'|'def||CR
    SAY pen6' |'def'   ['pen3'P'def']ost messages     'pen6'|'def||CR
    SAY pen6' |'def'   ['pen3'R'def']ead messages     'pen6'|'def||CR
    SAY pen6' |'def'   ['pen3'S'def']earch messages   'pen6'|'def||CR
    SAY pen6' |'def'   ['pen3'E'def']mail (private)   'pen6'|'def||CR
    SAY pen6' |'def'   ['pen3'C'def']omment to SYSOP  'pen6'|'def||CR
    SAY pen6' |'def'   ['pen3'!'def'] YELL for SYSOP  'pen6'|'def||CR
    MSG pen6' |'def'   ['pen3'\'def'] Chat            'pen6'|'def
IF(level>sysoplevel) THEN DO
    SAY pen6' |'def'   ['pen3'^'def'] view BBS logs   'pen6'|'def||CR
    SAY pen6' |'def'   ['pen3')'def'] email report    'pen6'|'def||CR
    SAY pen6' |'def'   ['pen3'='def'] level report    'pen6'|'def||CR;END
IF(level=99) THEN DO;
    SAY pen6' |'def'   ['pen3'&'def'] online editor   'pen6'|'def||CR
    SAY pen6' |'def'   ['pen3'@'def'] dos shell       'pen6'|'def||CR;END
    SAY pen6' |'def'   ['pen3'F'def']iles menu        'pen6'|'def||CR
    SAY pen6' |'def'   ['pen3'.'def'] main menu       'pen6'|'def||CR
    SAY pen6' |_______________________|'def||CR
END
ELSE IF menu='FILE' THEN
DO
    SAY pen6'         _________'def||CR
    SAY pen6'  ______/  'pen3'Files'pen6'  \_______'def||CR
    SAY pen6' |                        |'def||CR
    SAY pen6' |'def'   ['pen3'H'def']elp               'pen6'|'def||CR
    SAY pen6' |'def'   ['pen3'B'def']rowse filenotes   'pen6'|'def||CR
    SAY pen6' |'def'   ['pen3'N'def']ew files list     'pen6'|'def||CR
    SAY pen6' |'def'   ['pen3'L'def']ist files         'pen6'|'def||CR
    SAY pen6' |'def'   ['pen3'S'def']earch files       'pen6'|'def||CR
    SAY pen6' |'def'   ['pen3'V'def']iew textfile      'pen6'|'def||CR
    SAY pen6' |'def'   ['pen3'U'def']pload             'pen6'|'def||CR
    SAY pen6' |'def'   ['pen3'D'def']ownload           'pen6'|'def||CR
    SAY pen6' |'def'   ['pen3'T'def']ransfer protocol  'pen6'|'def||CR
IF(level>sysoplevel) THEN DO
    SAY pen6' |'def'   ['pen3'K'def']ill a user        'pen6'|'def||CR
    SAY pen6' |'def'   ['pen3'%'def'] edit filenote    'pen6'|'def||CR
    SAY pen6' |'def'   ['pen3'('def'] file report      'pen6'|'def||CR;END
IF(level=99) THEN DO;
    SAY pen6' |'def'   ['pen3'-'def'] edit filecomment 'pen6'|'def||CR
    SAY pen6' |'def'   ['pen3'@'def'] dos shell        'pen6'|'def||CR;END
    MSG pen6' |'def'   ['pen3'\'def'] Chat             'pen6'|'def
    SAY pen6' |'def'   ['pen3'M'def']essages menu      'pen6'|'def||CR
    SAY pen6' |'def'   ['pen3'.'def'] main menu        'pen6'|'def||CR
    SAY pen6' |________________________|'def||CR
END
ELSE IF menu='MAIN' THEN
DO
    SAY pen6'       _____________'def||CR
    SAY pen6'  ____/  'pen3'Main Menu'pen6'  \_____'def||CR
    SAY pen6' |                        |'def||CR
    SAY pen6' |'def'   ['pen3'H'def']elp               'pen6'|'def||CR
    SAY pen6' |'def'   ['pen3'I'def']nfomation         'pen6'|'def||CR
    SAY pen6' |'def'   ['pen3'J'def']ump to doorways   'pen6'|'def||CR
    SAY pen6' |'def'   ['pen3'Y'def']our user data     'pen6'|'def||CR
    SAY pen6' |'def'   ['pen3'W'def']ho is here list   'pen6'|'def||CR
    SAY pen6' |'def'   ['pen3'S'def']earch userlist    'pen6'|'def||CR
    SAY pen6' |'def'   ['pen3'O'def']ther users info   'pen6'|'def||CR
    SAY pen6' |'def'   ['pen3'X'def']pert (no menus)   'pen6'|'def||CR
    SAY pen6' |'def'   ['pen3'#'def'] toggle colors    'pen6'|'def||CR
    SAY pen6' |'def'   ['pen3'$'def'] toggle menu(s)   'pen6'|'def||CR
    SAY pen6' |'def'   ['pen3'Z'def'] bbs statistics   'pen6'|'def||CR
    SAY pen6' |'def'   ['pen3'G'def']oodbye (hangup)   'pen6'|'def||CR
    MSG pen6' |'def'   ['pen3'\'def'] Chat             'pen6'|'def
    SAY pen6' |'def'   ['pen3'F'def']iles menu         'pen6'|'def||CR
    SAY pen6' |'def'   ['pen3'M'def']essages menu      'pen6'|'def||CR
    SAY pen6' |________________________|'def||CR
END
ELSE IF menu='ALL' THEN
DO
    SAY pen6'     __________________________________________________________'def||CR
    SAY pen6'  __/   'pen3'Main Menu            File Menu          Message Menu 'pen6'  \__'def||CR
    SAY pen6' |                                                                |'def||CR
    SAY pen6' |'def' ['pen3'H'def']elp               ['pen3'B'def']rowse filenotes   ['pen3'P'def']ost messages      'pen6'|'def||CR
    SAY pen6' |'def' ['pen3'I'def']nfomation         ['pen3'N'def']ew files list     ['pen3'R'def']ead messages      'pen6'|'def||CR
    SAY pen6' |'def' ['pen3'W'def']ho is here list   ['pen3'L'def']ist files by Lib  ['pen3'E'def']mail (private)    'pen6'|'def||CR
    SAY pen6' |'def' ['pen3'Y'def']our user data     ['pen3'U'def']pload             ['pen3'C'def']omment to SYSOP   'pen6'|'def||CR
    SAY pen6' |'def' ['pen3'O'def']ther users info   ['pen3'D'def']ownload           ['pen3'!'def'] YELL for SYSOP   'pen6'|'def||CR
    SAY pen6' |'def' ['pen3'J'def']ump to doorways   ['pen3'V'def']iew textfile      ['pen3'X'def']pert (no menus)   'pen6'|'def||CR
    SAY pen6' |'def' ['pen3'S'def']earch menu        ['pen3'T'def']ransfer protocol  ['pen3'$'def'] toggle menu(s)   'pen6'|'def||CR
    SAY pen6' |'def' ['pen3'G'def']oodbye (logoff)   ['pen3'Z'def'] bbs statiZtics   ['pen3'#'def'] toggle colors    'pen6'|'def||CR
IF(level>sysoplevel) THEN DO
    SAY pen6' |'def' ['pen3'K'def']ill a user        ['pen3'%'def'] edit filenote    ['pen3'='def'] level report     'pen6'|'def||CR
    SAY pen6' |'def' ['pen3'^'def'] view BBS logs    ['pen3'('def'] file report      ['pen3')'def'] email report     'pen6'|'def||CR;END
IF(level=99) THEN
    SAY pen6' |'def' ['pen3'@'def'] dos shell        ['pen3'-'def'] edit filecomment ['pen3'&'def'] online editor    'pen6'|'def||CR
    MSG pen6' |'def'                                           ['pen3'\'def'] Chat             'pen6'|'def
    SAY pen6' |________________________________________________________________|'def||CR
END
SAY CR
RETURN;


help:
ARG helppath .
SAY CR
SAY 'For more detailed help, use the ['pen3'I'def']nformation commmand to read HELP.'CR
IF helppath='MAIN' THEN
  SAY 'Commands available from the' pen3||menu||def 'menu:'CR
frontend=bbspath'BBS_HELP/'helppath
backend='.USER'
IF level=0 THEN backend='.NEW'
ELSE IF level=99 THEN backend='.SUPER'
ELSE IF level>sysoplevel THEN backend='.SYSOP'
CALL showtext(frontend||backend);
RETURN;


waiting:
CALL checktime();
waitchar=''
IF nonstop=1 THEN RETURN;
OPTIONS PROMPT pen3'                       RETURN=Continue 'def
PULL waitchar
CALL cleanline(1);
CALL checkdcd();
RETURN;


cleanline:
ARG lflag .
cline=lineup||LEFT(' ',78)
IF lflag=1 THEN cline=cline||lineup
SAY cline||CR
RETURN;


getinput:
PARSE ARG upflag' 'oneflag' 'pline
OPTIONS PROMPT pline
PARSE PULL inarg
inarg=STRIP(inarg)
IF upflag THEN inarg=UPPER(inarg)
IF oneflag THEN inarg=LEFT(inarg,1)
CALL checkdcd();
RETURN(inarg);


postuser:
IF bbsprefs.12~=1 THEN RETURN;
ARG upflag .
line2=''
IF upflag=6 THEN line2=line2||CENTER('Logoff:' DATE() TIME('C')'  'name city,74)
ELSE line2=line2||CENTER(name city'  Last On:' DATE(,lastondate,'I'),74)
line2=line2'\'
line2=line2||CENTER('Baud:' bps'   Usage:' data.19,74)'\'
ulb=WORD(data.14,3)
IF ~DATATYPE(ulb,'N') THEN ulb=1
dlb=WORD(data.15,3)
IF ~DATATYPE(dlb,'N') THEN dlb=0
dlup=TRUNC(dlb/ulb+.005,2)
line3='Level: 'level'   dl/ul:' dlup
IF upflag=0 THEN line2=line2||CENTER(line3,74)
IF upflag=1 THEN line2=line2||CENTER(line3'   Cmd:' opt arg,74)
IF upflag=2 THEN line2=line2||CENTER(line3'   MSG:' msg.msgdir,74)
IF upflag=3 THEN line2=line2||CENTER(line3'   Email',74)
IF upflag=4 THEN line2=line2||CENTER(line3'   ul:' arg,74)
IF upflag=5 THEN line2=line2||CENTER(line3'   dl:' arg,74)
IF upflag=6 THEN
  DO
    line3=line3'   Elapsed:'elapsed' '
    IF EXISTS(bbspath'Email/'sysop'/NEW_FILES') THEN line3=line3 'NEW_FILES'
    IF EXISTS(bbspath'Email/'sysop'/NEW_USERS') THEN line3=line3 'NEW_USERS'
    line2=line2||CENTER(line3,74)
  END
CALL PostMsg(3,14,line2)
RETURN;


whodat:
MSG RIGHT(' ',66-LENGTH(name)) pen0||bak1' 'name' level 'level' 'def||CR||lineup
RETURN;


checktime:
IF TIME('E')>maxtime THEN
  DO
    SAY 'Sorry,' name 'your time has expired.'CR
    CALL send2log('*** Time Expired ***');
    CALL OUT
  END
IF TIME('E')>(maxtime-120) THEN SAY '*** Less than 2 minutes left! ***'CR
CALL whodat();
CALL checkdcd();
RETURN;


setdir:
PARSE ARG tempdir
CALL PRAGMA('D',STRIP(tempdir))
directory=PRAGMA('D')
Data directory
slash=LASTPOS('/',directory)
IF slash=0 THEN slash=LASTPOS(':',directory)
plaindir=directory
IF slash>0 THEN plaindir=SUBSTR(plaindir,slash+1)
RETURN;


readlogs:
IF arg='' THEN
  arg=getinput(1 0 '['pen3'RETURN'def']=TODAY, or enter Log Date ('pen3||DATE('S')||def') > ');
IF arg='' THEN arg=DATE('S')
arg=bbspath'Logs/log.'arg
CALL readlines(arg 1);
CALL seelines();
nonstop=0
CALL waiting();
RETURN;


otheruser:
SAY CR
SAY 'To allow (or not) other users to see your street address and/or phone number,'CR
SAY 'add (or delete) STREET and/or PHONE to the line 8 list in ['pen3'Y'def']our userfile.'CR
SAY CR
SAY 'User specification may include ? wildcard for single characters. 'CR
SAY 'ie,' pen3's?n'def 'will return all user names containing ''son'', ''sen'', ''sin'', etc.'CR
IF arg='' THEN arg=getinput(1 0 pen3'User specification: 'def)
IF arg='' THEN RETURN;
arg=TRANSLATE(STRIP(arg),'_',' ')
CALL FileList(bbspath'Users/*'arg'*',wildlist)
line='Found' wildlist.0 'match'
IF wildlist.0~=1 THEN line=line'es'
SAY line'.'CR
IF wildlist.0<1 THEN RETURN;
totlines=0
nextpagebreak=linesperpage-3
extrainfo=0
IF level>sysoplevel THEN
  DO
    IF getinput(1 1 'Display -sysop only- information? (nY) > ')~='N' THEN
      extrainfo=1
  END
DO i=1 TO wildlist.0
  CALL readlines(wildlist.i 1)
  SAY CR
  totlines=totlines+4
  SAY lynes.1||CR
  IF FIND(UPPER(lynes.8),'STREET')>0 THEN
    DO
      totlines=totlines+1
      SAY lynes.2||CR
    END
  SAY lynes.3||CR
  IF FIND(UPPER(lynes.8),'PHONE')>0 THEN
    DO
      totlines=totlines+1
      SAY lynes.4||CR
    END
  SAY 'Last time on' bbsname':' DATE(,WORD(lynes.13,1),'S') WORD(lynes.13,2)||CR
  SAY pen3'Interests:'def lynes.10||CR
  IF extrainfo THEN
    DO
      SAY pen3'   up:'def lynes.14||CR
      SAY pen3' down:'def lynes.15||CR
      temptot=0
      DO j=1 TO WORDS(lynes.23)
        IF DATATYPE(WORD(lynes.23,j),'N') THEN temptot=temptot+WORD(lynes.23,j)
      END
      SAY pen3' writ:'def temptot 'public messages.'CR
      SAY pen3'level:'def lynes.20||CR
      totlines=totlines+4
      IF lynes.21~='' THEN
        DO
          totlines=totlines+1
          SAY pen3'excluded dirs:'def lynes.21||CR
        END
    END
  IF totlines>=nextpagebreak THEN
    DO
      CALL waiting();
      nextpagebreak=totlines+linesperpage-3
    END
END
CALL waiting();
RETURN;


levelreport:
DO i=1 TO WORDS(userlist)
  arg=bbspath'Users/'WORD(userlist,i)
  CALL readlines(arg 1)
  line=lynes.20 WORD(userlist,i)
  SAY line||CR
  IF ~DATATYPE(WORD(lynes.20,1),'N') | WORD(lynes.20,1)=0 THEN
    DO
      temp=getinput(1 1 '[A]dd or [K]ill this user? (kA) > ');
      IF temp='K' THEN
        DO
          arg=WORD(userlist,i)
          CALL killuser();
          CALL cleanline();
        END
      ELSE
        DO
          IF readopen(bbspath'BBS_TEXT/DEF.MEMBER') THEN
            DO
              DO lvi=1 TO 21
                line=READLN(f)
                IF lvi=11 THEN lynes.11=line
                IF lvi=20 THEN lynes.20=line
              END
              lynes.21=line
              CALL CLOSE(f)
              edtype=''
              CALL savelines(arg);
            END
          ELSE SAY 'You need a default member file in BBS_TEXT!   ( BBS_TEXT/DEF.MEMBER )'CR
        END
    END
  IF i//linesperpage=0 THEN CALL waiting();
END
RETURN;


filereport:
IF getinput(1 1 'Check against filelist? (yN) > ')='Y' THEN dokk=1
ELSE dokk=0
SAY 'Searching for mismatches between files and filenotes...'CR
kk=countcheck(bbspath'Numbers/LastFile')
DO i=1 TO sysoplevel+1
  IF dirs.i='' THEN ITERATE
  SAY dirs.i'                               'lineup||CR
  rfiles=SHOWDIR(libpath||dirs.i)
  rnotes=SHOWDIR(bbspath'FileNotes/'dirs.i)
  IF WORDS(rfiles)~=WORDS(rnotes) THEN
    DO
      line='Compare files & filenotes in'pen3 dirs.i||def'. '
      DO j=1 TO WORDS(rfiles)
        IF FIND(UPPER(rnotes),UPPER(WORD(rfiles,j)))=0 THEN
          line=line WORD(rfiles,j)
      END
      SAY line||CR
    END
  DO j=1 TO WORDS(rfiles) WHILE dokk
    DO k=1 TO kk
      IF files.k='' THEN ITERATE k
      IF UPPER(WORD(rfiles,j))=UPPER(WORD(files.k,2)) THEN ITERATE j
    END
    SAY WORD(rfiles,j) 'is not on the filelist.'CR
  END
END
Send '^G'
CALL waiting();
RETURN;


mailreport:
SAY 'Searching for ALL pending Email...'CR
SAY pen3' - Use CTRL-E to Exit -'def||CR
mailrep=SHOWDIR(bbspath'Email')
mailfil=SHOWDIR(bbspath'EmailFiles')
emailnum=0
lastemail=WORD(data.17,3)
IF ~DATATYPE(lastemail,'N') THEN lastemail=0
mailynes.=''
mk=0
DO mi=1 TO WORDS(mailrep)
  muser=WORD(mailrep,mi)
  mlist=SHOWDIR(bbspath'Email/'muser)
  DO mj=1 TO WORDS(mlist)
    fuser=WORD(mlist,mj)
    mk=mk+1
    mailynes.mk=pen3||LEFT(muser,20) 'from'def LEFT(fuser,20) DATE(,WORD(STATEF(bbspath'Email/'muser'/'fuser),5),'I')
    IF POS(sysop,fuser)=0 & POS(name,fuser)=0 THEN
      DO
        testnum=RIGHT(fuser,LENGTH(fuser)-LASTPOS('.',fuser))
        IF testnum>emailnum THEN emailnum=testnum
        IF testnum>lastemail THEN CALL showtext(bbspath'Email/'muser'/'fuser);
      END
  END
  IF FIND(mailfil,muser)>0 THEN
    DO
      efilelist=SHOWDIR(bbspath'EmailFiles/'muser)
      IF WORDS(efilelist)>0 THEN
        DO
          mk=mk+1
          mailynes.mk=pen3||LEFT(muser,20) 'emailfiles'def efilelist
        END
    END
END
data.17=WORD(data.17,1) WORD(data.17,2) emailnum
IF mk>0 THEN
  DO
    lynes.0=mk
    DO mi=1 TO mk
      lynes.mi=mailynes.mi
    END
    CALL seelines();
    nonstop=0
    CALL waiting();
  END
ELSE SAY 'No Email pending.'CR
RETURN;


jump2rexx:
IF ~DATATYPE(jdoors.0,'N') THEN
  DO
    jdoors.=''
    doorlist=SHOWDIR(bbspath'rexxDoors','F')
    doors.=''
    doors.0=WORDS(doorlist)
    DO i=1 TO doors.0
      doors.i=WORD(doorlist,i)
    END
    SAY 'Sorting..'lineup||CR
    CALL QSORT(1,doors.0,doors)
    jdoors.0=doors.0%3
    IF (doors.0//3)>0 THEN jdoors.0=jdoors.0+1
    DO i=1 TO jdoors.0
      jdoors.i=LEFT(RIGHT(i,3)'.' LEFT(doors.i,LENGTH(doors.i)-5),24)
      DO j=1 TO 2
        k=i+j*jdoors.0
        IF k<=doors.0 THEN
          jdoors.i=jdoors.i' 'LEFT(RIGHT(k,3)'.' LEFT(doors.k,LENGTH(doors.k)-5),24)
      END
    END
  END
DO doorloop=1
  SAY pen3||LEFT('-',75,'-')||def||CR
  DO jd=1 TO jdoors.0
    SAY jdoors.jd||CR
    IF jd//linesperpage=0 THEN CALL waiting();
    IF waitchar='Q' THEN RETURN;
  END
  temp=getinput(1 0 pen3'Select Application Number > 'def);
  IF ~DATATYPE(temp,'N') | temp<1 | temp>doors.0 THEN RETURN;
  curdir=PRAGMA('D')
  CALL setdir(bbspath'rexxDoors');
  CALL SETCLIP('BBS_winnings')
  savewinnings=0
  IF UPPER(doors.temp)='ONE_ARMED_BANDIT.REXX' THEN
    IF getinput(1 1 'Play for this sessions time in seconds? (yN) > ')='Y' THEN
      DO
        savewinnings=winnings
        winnings=TRUNC(maxtime-TIME('E'))
        SAY 'Playing for REAL seconds, not wimpy play-dollars!'CR
      END
  INTERPRET 'call' doors.temp'('name winnings savewinnings')'
  testwin=GETCLIP('BBS_winnings')
  IF DATATYPE(testwin,'N') THEN
    DO
      IF testwin>7200 THEN
        DO
          SAY 'Although you won' TRUNC(testwin/60) 'minutes, the maximum session time is 120 minutes.'CR
          testwin=7200
        END
      winnings=testwin
      IF savewinnings>0 THEN
        DO
          maxtime=TRUNC(testwin+TIME('E'))
          winnings=savewinnings
        END
    END
  CALL setdir(curdir);
  CALL checktime();
  CALL SETCLIP('BBS_winnings')
END
RETURN;


sortlibraries:
SAY 'Sorting Libraries...'lineup||CR
count=0
sdirs.=''
DO i=1 TO level
  IF dirs.i='' THEN ITERATE i
  count=count+1
  sdirs.count=dirs.i i
END
sdirs.0=count
CALL QSort(1,count,sdirs);
count=0
libs.=''
DO i=1 TO sdirs.0
  tempnum=WORD(sdirs.i,2)
  tempdir=WORD(sdirs.i,1)
  IF FIND(UPPER(data.21),UPPER(tempdir))=0 THEN
    DO
      string=' '
      IF tempnum<10 THEN string=string' '
      string=string || tempnum'. 'LEFT(tempdir,14)
      count=count+1
      libs.count=string
    END
END
libs.0=count%4
IF (count//4)>0 THEN libs.0=libs.0+1
DO i=1 TO libs.0
  DO j=1 TO 3
    k=i+j*libs.0
    IF k<=count THEN libs.i=libs.i libs.k
  END
END
CALL sortconferences();
RETURN;


sortconferences:
SAY 'Sorting Conferences...'lineup||CR
count=0
smsg.=''
DO i=1 TO level
  IF msg.i='' THEN ITERATE i
  count=count+1
  smsg.count=msg.i i
END
smsg.0=count
CALL QSort(1,count,smsg);
count=0
msgs.=''
DO i=1 TO smsg.0
  tempnum=WORD(smsg.i,2)
  tempdir=WORD(smsg.i,1)
  IF FIND(UPPER(data.21),tempnum)=0 THEN
    DO
      string=' '
      IF tempnum<10 THEN string=string' '
      string=string || tempnum'.'
      IF WORD(data.22,tempnum)='' | WORD(data.22,tempnum)>=0 THEN
        string=string LEFT(tempdir,20)
      ELSE string=string pen3'-OFF-'def LEFT(tempdir,14)
      count=count+1
      msgs.count=string
    END
END
msgs.0=count%3
IF (count//3)>0 THEN msgs.0=msgs.0+1
DO i=1 TO msgs.0
  DO j=1 TO 2
    k=i+j*msgs.0
    IF k<=count THEN msgs.i=msgs.i msgs.k
  END
END
RETURN;


readmessages:
DO FOREVER
  SAY CR
  IF DATATYPE(arg,'N') THEN msgdir=arg
  ELSE IF LEFT(UPPER(arg),1)='A' THEN
    DO
      CALL newmsgs();
      RETURN;
    END
  ELSE
    DO
      SAY 'Select Message Conference By Number or ['pen3'A'def']ll Active'CR
      IF areaselect() THEN
        DO
          IF LEFT(temp,1)='A' THEN CALL newmsgs();
          waitchar=temp
          RETURN;
        END
    END
  junk=getinput(1 1 '['pen3'M'def']ask ON/OFF  ['pen3'R'def']ead  ['pen3'Q'def']uit (Rmq) > ')
  IF junk='Q' THEN RETURN;
  IF junk='M' THEN
    DO
      line='Turning the' msg.msgdir 'conference'
      IF WORD(data.22,msgdir)<0 THEN
        DO
          line=line pen3'ON'def'.'
          newdata='0'
        END
      ELSE
        DO
          line=line pen3'OFF'def'.'
          newdata='-1'
        END
      SAY line||CR
      dataloc=WORDINDEX(data.22,msgdir)-1
      data.22=DELWORD(data.22,msgdir,1)
      data.22=INSERT(newdata' ',data.22,dataloc)
      CALL sortconferences();
    END
  CALL readmsg(0);
  CALL saveData(1);
  nonstop=0
  arg=''
END
RETURN;


newmsgs:
curmsgdir=msgdir
SAY 'Scanning all Conferences for new messages..'CR
DO newi=1 TO level
  IF newi>level THEN LEAVE newi
  IF msg.newi='' THEN ITERATE newi
  msgdir=newi
  CALL readmsg(1);
  IF msgcom='Q' THEN LEAVE newi
END
CALL saveData(1);
msgdir=curmsgdir
nonstop=0
RETURN;


readmsg:
ARG quietflag
IF msg.msgdir='' | FIND(data.21,msgdir)>0 THEN RETURN;   /* sysop excluded */
IF WORD(data.22,msgdir)=-1 THEN RETURN;  /*  user excluded */
IF quietflag=0 THEN SAY 'Entering' msg.msgdir 'Message Conference..'CR
CALL postuser(2);
IF DATATYPE(WORD(data.22,msgdir),'N') THEN
  lastread.msgdir=WORD(data.22,msgdir)
ELSE lastread.msgdir=0
lstwrt=countcheck(bbspath'Numbers/LastMessage'msgdir 0)
temp=''
IF lastread.msgdir>=lstwrt THEN
  DO
    lastread.msgdir=lstwrt
    CALL msgcount(msgdir);
    IF quietflag=1 THEN RETURN;
    temp=getinput(1 0 pen3'Enter starting message number > 'def);
    IF ~DATATYPE(temp,'N') THEN RETURN;
    IF temp<1 THEN temp=1
    lastread.msgdir=temp-1
  END
dirname=msgpath||msgdir
testlist=sortnumbers(SHOWDIR(dirname));
msglist.=0                /* set read to 0, unread to 1, and reply >=2 */
DO i=1 TO WORDS(testlist)
  test=WORD(testlist,i)
  IF test>lastread.msgdir THEN msglist.test=1
END
msgstatus=1
IF temp='' THEN CALL msgcount(msgdir);
DO msgloop=1 WHILE lastread.msgdir<lstwrt
  lastreadnum=lastread.msgdir
  DO WHILE msglist.lastreadnum=0 & lastreadnum<lstwrt
    lastreadnum=lastreadnum+1
  END
  lastread.msgdir=lastreadnum
  DO mess=lastread.msgdir TO lstwrt+1
    IF msglist.mess~=msgstatus THEN ITERATE mess
    IF mess>lstwrt THEN RETURN;
    IF msgstatus>1 THEN SAY 'Following the thread, level' msgstatus-1'.'CR
    msglist.mess=0
    arg=dirname'/'mess
    IF ~EXISTS(arg) THEN
      DO
        SAY 'Message number' mess 'is missing.'CR
        ITERATE mess
      END
    IF ~readopen(arg) THEN ITERATE mess
    firstline  = READLN(f)
    secondline = READLN(f)
    thirdline  = READLN(f)
    forthline  = READLN(f)
    CALL CLOSE(f)
    CALL killmark(msgdir mess)
    CALL DELAY(28)
    IF WORDS(firstline)>2 THEN  /* if replies, change their num to 2 */
      DO
        thread=SUBSTR(firstline,WORDINDEX(firstline,4))
        DO tindx=1 TO WORDS(thread)
          test=WORD(thread,tindx)
          IF msglist.test~=0 THEN msglist.test=msgstatus+1
        END
      END
    savearg=arg
    msgcom='A'
    DO msgloop2=1 WHILE msgcom='A' | msgcom='O'
      CALL readlines(arg 1);
      IF nonstop=1 THEN rnonstop=1
      ELSE rnonstop=0
      CALL seelines();
      msgcom=''
      IF rnonstop THEN
        DO
          SAY CR
          nonstop=1
          msgcom=''
        END
      ELSE
        DO
          pline='['pen3'A'def']gain ['pen3'H'def']elp'
          IF level>sysoplevel | name=WORD(lynes.2,2) THEN
            pline=pline '['pen3'E'def']dit ['pen3'K'def']ill'
          IF WORDS(lynes.3)>3 THEN pline=pline '['pen3'O'def']riginal'
          pline=pline '['pen3'N'def']onStop ['pen3'R'def']eply'
          pline=pline '['pen3'S'def']kip ['pen3'Q'def']uit'
          msgcom=getinput(1 0 pline' > ');
          CALL cleanline(0);
        END
      CALL checktime();
      IF DATATYPE(msgcom,'N') & EXISTS(dirname'/'msgcom) THEN
        DO
          arg=dirname'/'msgcom
          msgcom='A'
          ITERATE msgloop2
        END
      ELSE msgcom=LEFT(msgcom,1)
      IF msgcom='Q' THEN LEAVE msgloop
      ELSE IF msgcom='A' THEN ITERATE msgloop2
      ELSE IF msgcom='N' THEN
        DO
          nonstop=1
          msgcom=''
        END
      ELSE IF msgcom='H' THEN
        DO
          SAY pen3' - HELP with the Read Messages commands -'def||CR
          SAY ' RETURN reads the next message in line.'CR
          SAY ' 34 will read message number 34, if it exists in this conference.'CR
          SAY ' A  reads this message Again (in case it scrolled off screen).'CR
          IF level>sysoplevel | name=WORD(lynes.2,2) THEN
            DO
          SAY ' E  puts this message into the online Editor.'CR
          SAY ' K  deletes a message you wrote. you cannot Kill others!'CR
            END
          SAY ' N  displays all new messages without pausing. CTRL-E to Exit!'CR
          SAY ' O  if this message is a reply, will read the Original message.'CR
          SAY ' R  enters the message editor to Reply to this message.'CR
          SAY ' S  allows you to Skip threads or conferences.'CR
          SAY ' Q  returns to the message menu. (Quit)'CR
          SAY CR
          CALL waiting();
          msgcom='A'
          IF waitchar='Q' THEN LEAVE msgloop
        END
      ELSE IF msgcom='E' THEN
        DO
          IF level>sysoplevel | name=WORD(lynes.2,2) THEN
            DO
              sline=7
              IF level>sysoplevel THEN sline=1
              CALL bbsED(sline arg);
              msgcom='A'
            END
        END
      ELSE IF msgcom='S' THEN
        DO
          stemp=getinput(1 1 'Skip this ['pen3'T'def']hread or the entire ['pen3'C'def']onference (tc) > ');
          IF stemp='T' THEN
            DO
              SAY 'Skipping this message AND its replies..'CR
              DO i=lastread.msgdir TO lstwrt
                IF msglist.i>1 THEN msglist.i=0
              END
            END
          ELSE IF stemp='C' THEN
            DO
              SAY 'Skipping to the last message in the' msg.msgdir 'conference.'
              lastread.msgdir=lstwrt-1
              lw=lstwrt-1
              msglist.lw=0
              msglist.lstwrt=1
              LEAVE mess
            END
        END
      ELSE IF msgcom='K' THEN
        DO
          IF level>sysoplevel | name=WORD(lynes.2,2) THEN
            DO
              IF getinput(1 1 'Really delete' arg'? (yN) > ')='Y' THEN
                DO
                  CALL DELETE(arg)
                  SAY pen3||arg||def' has been deleted.'
                END
            END
        END
      ELSE IF msgcom='O' THEN   /* go back and read original */
        DO
          IF WORDS(lynes.3)>3 THEN
            DO
              temp=WORD(lynes.3,4)
              arg=dirname'/'temp
            END
          ELSE SAY 'This is the original message.'CR
        END
      ELSE IF msgcom='R' THEN        /*  toname     msgnum  */
        DO
          msgnum=WORD(lynes.1,2)
          IF editor('REPLY' WORD(lynes.2,2) msgnum) THEN /* reply */
            DO
              savearg2=arg
              arg=dirname'/'WORD(lynes.3,4)
              IF EXISTS(arg) THEN
                DO
                  IF readlines(arg 1) THEN BREAK;
                  xmsg=countcheck(bbspath'Numbers/LastMessage'msgdir mess)
                  IF WORDS(lynes.1)>3 THEN lynes.1=lynes.1 xmsg
                  ELSE lynes.1=lynes.1'   Reply' xmsg
                  CALL DELAY(28)    /* allow 1/2 sec for read to close */
                  IF savelines(arg) THEN RETURN;
                END
              arg=savearg2
            END
        END
      ELSE IF arg~=savearg THEN    /* Continue */
        DO
          msgcom='A'
          arg=savearg
        END
      CALL checktime();
    END
    IF thread~='' THEN
      DO
        thread=''
        msgstatus=msgstatus+1
      END
  END
  IF msgstatus>1 THEN msgstatus=msgstatus-1
END
waitchar=''
nonstop=0
RETURN;


showmarked:
IF WORDS(data.24)<1 THEN RETURN;
SAY CR
SAY pen3'These unread conference messages are addressed to you:'def||CR
DO i=1 TO WORDS(data.24)
  tempk=WORD(data.24,i)
  PARSE VAR tempk kdir'/'kmsg
  SAY RIGHT(kmsg,6) 'in the' msg.kdir 'conference.'CR
END
CALL waiting();
SAY CR
RETURN;


killmark:
PARSE ARG kdir kmsg .
markword=FIND(data.24,kdir'/'kmsg)
IF markword>0 THEN data.24=STRIP(DELWORD(data.24,markword,1))
RETURN;


sortnumbers:
PARSE ARG slist
sorted.=''
newest=0
newlist=''
DO si=1 TO WORDS(slist)
  tempnum=WORD(slist,si)/1
  sorted.tempnum=1
  IF tempnum>newest THEN newest=tempnum
END
DO si=1 TO newest
  IF sorted.si~=1 THEN ITERATE si
  newlist=newlist si
END
RETURN(STRIP(newlist));


readmail:
ARG fromenu .
CALL postuser(3);
replysubj=''
IF fromenu THEN
  DO
    temp=UPPER(arg)
    arg=''
    IF temp~='F' & temp~='T' & temp~='W' THEN
      DO
        line='Find Email ['pen3'F'def']rom You ['pen3'T'def']o You or ['pen3'W'def']rite New Email > 'def
        temp=getinput(1 1 line);
        CALL cleanline(0);
      END
    IF temp='W' THEN
      DO
        CALL editor('MAIL');
        RETURN;
      END
    ELSE IF temp='F' THEN
      DO
        SAY pen3'You have Email pending to the following users:'def||CR
        firsteditline=0
        picklist.=''
        picklist.0=0
        DO ei=1 TO WORDS(userlist)
          fmaillist=SHOWDIR(bbspath'EMail/'WORD(userlist,ei))
          DO ej=1 TO WORDS(fmaillist)
            ejname=WORD(fmaillist,ej)
            uname=ejname
            caret=LASTPOS('.',uname)
            IF caret>2 THEN uname=LEFT(uname,caret-1)
            IF uname=name THEN
              DO
                arg=bbspath'EMail/'WORD(userlist,ei)'/'ejname
                IF EXISTS(arg) THEN
                  DO
                    pklst=picklist.0+1
                    picklist.pklst=WORD(userlist,ei)
                    picklist.pklst.0=ejname
                    picklist.0=pklst
                  END
              END
          END
        END
        IF picklist.0=0 THEN SAY lineup'No Email FROM you was found.                    'CR
        ELSE
          DO
            pickcheck=1
            DO WHILE pickcheck~=0
              pickcheck=pickfromlist();
              IF pickcheck~=0 THEN
                DO
                  firsteditline=5
                  IF level>sysoplevel THEN firsteditline=1
                  CALL bbsED(firsteditline bbspath'Email/'picklist.pickcheck'/'picklist.pickcheck.0);
                END
            END
          END
        RETURN;
      END
    ELSE IF temp='T' THEN BREAK;
    ELSE RETURN;
  END
SAY 'Checking your mailbox..'CR
nomail=1
CALL MAKEDIR(bbspath'EMail/'name)
mailist=SHOWDIR(bbspath'Email/'name)
IF WORDS(mailist)>0 THEN
  DO
    line=WORDS(mailist)
    IF line>1 THEN line=line 'letters'
    ELSE line=line 'letter'
    line=line 'waiting.'
    SAY line||CR
    DO ii=1 TO WORDS(mailist)
      SAY 'Email:' pen3||WORD(mailist,ii)||def||CR
    END
    IF ~fromenu THEN
      IF getinput(1 1 'Read your private mail now? (nY) > ')='N' THEN RETURN;
  END
DO letter=1 TO WORDS(mailist)
  readname=WORD(mailist,letter)
  uname=readname
  caret=LASTPOS('.',uname)
  IF caret>2 THEN uname=LEFT(uname,caret-1)
  arg=bbspath'Email/'name'/'readname                       /* user has mail! */
  CALL readlines(arg 1)
  CALL seelines();
  nomail=0
  nonstop=0
  mailfile=''
  IF readname~='NEW_USERS' & readname~='NEW_FILES' & WORDS(lynes.2)>3 THEN
    DO
      mailfile=WORD(lynes.2,4)
      curdir=PRAGMA('D')
      CALL setdir(bbspath'EmailFiles/'name)
      filesize=WORD(STATEF(mailfile),2)
      IF getinput(1 1 ' Attached file:' pen3||mailfile||def 'is' pen3||filesize||def 'bytes.  Download now? (nY) > ')~='N' THEN
        DO
          savearg=arg
          arg=mailfile
          CALL dload();
          arg=savearg
        END
      CALL setdir(curdir)
    END
  IF readname~='NEW_USERS' & readname~='NEW_FILES' THEN
    DO
      IF getinput(1 1 'Reply to this message? (nY) > ')~='N' THEN
        DO
          replysubj=SUBSTR(lynes.4,WORDINDEX(lynes.4,2))
          CALL editor('MAIL' uname);
          replysubj=''
        END
    END
  junk=getinput(1 1 'Forward mail from'pen3 uname def'to other users? (yN) > ');
  IF junk='Y' THEN
    DO
      IF selectchosen(1 pen3'Forward Email To: 'def) THEN BREAK;
      DO ei=1 TO thechosen.0
        CALL MAKEDIR(bbspath'EMail/'thechosen.ei)
        forwardarg=bbspath'Email/'thechosen.ei'/'readname
        ADDRESS COMMAND 'COPY' bbspath'Email/'name'/'readname forwardarg
        CALL readlines(forwardarg 1);
        lynes.1=lynes.1'  Forwarded to you by' name TIME('C') DATE()
        CALL DELETE(forwardarg)
        CALL savelines(forwardarg);
        IF WORDS(lynes.2)>3 THEN
          DO
            forname=bbspath'EmailFiles/'name'/'WORD(lynes.2,4)
            IF EXISTS(forname) THEN
              DO
                CALL MAKEDIR(bbspath'EmailFiles/'thechosen.ei)
                ADDRESS COMMAND 'COPY' forname bbspath'EmailFiles/'thechosen.ei
              END
          END
        line='Mail' pen3||readname||def 'forwarded to' pen3||thechosen.ei||def
        CALL send2log(line)
        SAY line||CR
      END
    END
  IF getinput(1 1 'Delete the mail from'pen3 uname def'you just read? (nY) > 'def)~='N' THEN
    DO
      dirname=bbspath'Email/'name'/'
      CALL DELETE(dirname||readname)
      tempstr='Mail'
      IF mailfile~='' & readname~='NEW_USERS' & readname~='NEW_FILES' & EXISTS(bbspath'EmailFiles/'name'/'mailfile) THEN
        DO
          CALL DELETE(bbspath'EmailFiles/'name'/'mailfile)
          tempstr=tempstr 'and attached file'
        END
      tempstr=tempstr 'deleted. Thank you for keeping a clean BBS!'
      SAY tempstr||CR
    END
  ELSE IF readname~='NEW_USERS' & readname~='NEW_FILES' THEN
    DO
      arg=bbspath'Email/'name'/'readname
      CALL readlines(arg 1)
      IF WORDS(lynes.3)<3 THEN
        DO
          lynes.3=lynes.3'  (R)'     /* received */
          CALL DELETE(arg)
          CALL savelines(arg)
          SAY 'Email has been marked as received.'CR
        END
    END
  CALL checktime();
  readname=''
  uname=''
  arg=''
END
IF nomail THEN
  DO
    SAY 'No mail was found.'CR
    CALL waiting();
  END
CALL setdir(libpath||dirs.1);
thechosen.=''
RETURN;


selectchosen:
PARSE ARG startat selectline
IF startat<2 THEN thechosen.=''
line='Enter list of comma separated user names'
IF level>sysoplevel THEN line=line 'or ALL'
SAY line||CR
thechosen.startat=getinput(1 0 selectline' ');
IF STRIP(thechosen.startat)='' THEN RETURN(1);
thechosen.startat=SPACE(thechosen.startat,1,'_')
thechosen.0=startat
IF level>sysoplevel & thechosen.startat='ALL' THEN
  thechosen.startat=SHOWDIR(bbspath'Users',,',')
IF POS(',',thechosen.startat)>0 THEN
  DO
    temp=TRANSLATE(thechosen.startat,' ',',')
    thechosen.0=WORDS(temp)+startat-1
    DO ei=startat TO thechosen.0
      thechosen.ei=WORD(temp,ei)
    END
  END
DO ei=startat TO thechosen.0
  DO WHILE FIND(userlist,thechosen.ei)=0
    CALL showuserlist();
    SAY thechosen.ei 'not found! Enter that name again or press RETURN.'CR
    thechosen.ei=getinput(1 0 pen3'Forward Email To: 'def);
    thechosen.ei=SPACE(thechosen.ei,1,'_')
    IF thechosen.ei='' THEN ITERATE ei
  END
END
RETURN(0);


countcheck:
PARSE ARG fname' 'cknum' '.
IF ~EXISTS(fname) THEN
  DO
    IF ~writeopen(fname) THEN RETURN(0);
    CALL WRITELN(f,cknum)
    CALL CLOSE(f)
    RETURN(cknum);
  END
IF ~readopen(fname) THEN RETURN(cknum);
retval=STRIP(READLN(f))
CALL CLOSE(f)
IF ~DATATYPE(retval,'N') THEN retval=0
IF ~DATATYPE(cknum,'N') THEN cknum=0
IF retval<cknum THEN
  DO
    IF writeopen(fname) THEN
      DO
        CALL WRITELN(f,cknum)
        CALL CLOSE(f)
        RETURN(cknum);
      END
  END
RETURN(retval);


pickfromlist:
DO pfl=1 TO picklist.0 BY 3
  pfl2=pfl+1
  pfl3=pfl+2
  pfline=pen3||RIGHT(pfl,2)||def LEFT(picklist.pfl,20)
  IF picklist.pfl2~='' THEN
    pfline=pfline pen3||RIGHT(pfl2,2)||def LEFT(picklist.pfl2,20)
  IF picklist.pfl3~='' THEN
    pfline=pfline pen3||RIGHT(pfl3,2)||def LEFT(picklist.pfl3,20)
  SAY pfline||CR
END
emnum=getinput(1 0 pen3'Select Email Number > 'def);
IF ~DATATYPE(emnum,'N') | emnum<1 | emnum>picklist.0 THEN RETURN(0);
RETURN(emnum);


sysED:
IF level<99 THEN RETURN;
arg=getinput(0 0 'Textfile To Edit: ');
IF arg='' THEN RETURN;
CALL bbsED(1 arg)
RETURN;


bbsED:
PARSE ARG firstedit editarg .
notchanged=1
IF readlines(editarg 1) THEN RETURN(1);
SAY CR
SAY '                   'pen3'Entering the EDITOR module..'def||CR
SAY CR
count=1
DO edloop=1
  IF edcom='S' & bbsprefs.5 THEN  /* spell check */
    DO
      SAY pen3'You must use ['def'R'pen3']eplace to make corrections.  'pen2'Spellchecking...'def||CR
      CALL DELETE(scratch'/SpellFile');
      CALL savelines(scratch'/SpellFile');
      curdir=PRAGMA('D')
      CALL setdir(spellpath);
      CALL SpellChk.rexx(scratch'/SpellFile');
      CALL setdir(curdir);
    END
  ELSE
    DO
      IF edcom='R' | edcom='I' | edcom='L' THEN CALL wrapbuf(7);
      IF count>=lynes.0 THEN count=1
      startcount=count
      DO i=startcount TO lynes.0+1
        IF ((i+1-startcount)//linesperpage)=0 THEN
          DO
            pline='                 ['pen3'E'def']dit'
            pline=pline '  ['pen3'RETURN'def']=Continue '
            edcom=getinput(1 1 pline);
            IF edcom~='' THEN LEAVE i
            CALL cleanline(1);
          END
        SAY pen3||RIGHT(i,2)||def lynes.i||CR
        count=count+1
      END
    END
  CALL checktime();
  pline=lineup' ['pen3'A'def']ppend ['pen3'C'def']ut ['pen3'I'def']nsert'
  pline=pline '['pen3'K'def']ill ['pen3'L'def']ist ['pen3'P'def']aste ['pen3'R'def']eplace'
  IF bbsprefs.5 THEN pline=pline '['pen3'S'def']pellcheck'
  pline=pline '> '
  edcom=getinput(1 1 pline);
  IF edcom='K' THEN
    DO
      junk=getinput(1 1 'Are you' pen3'sure'def 'you want to delete' editarg'? (yN) > ')
      IF junk='Y' THEN
        DO
          CALL DELETE(editarg)
          SAY editarg 'DELETED.'CR
          IF WORD(lynes.1,1)='Mail:' & WORDS(lynes.2)>3 THEN
            DO
              CALL DELETE(bbspath'EmailFiles/'WORD(lynes.3,2)'/'WORD(lynes.2,4))
              SAY WORD(lynes.2,4) 'DELETED.'CR
            END
          RETURN(2);
        END
    END
  IF edcom='' THEN
    DO
      SAY lineup'                   'pen3'Leaving the EDITOR module.                               'def||CR
      IF notchanged THEN RETURN(0);
      IF getinput(1 1 '                     Save changes? (nY)'pen3' > 'def)='N' THEN
        RETURN(1);
      CALL DELETE(editarg)
      IF savelines(editarg) THEN RETURN(1);
      SAY pen3'                        Changes saved.'def||CR
      RETURN(0);
    END
  ELSE IF edcom='C' THEN  /* Cut */
    DO
      firstnum=getinput(1 0 '   Enter line number or range 'pen3'(5-7)'def' to cut' pen3'>'def);
      IF firstnum='' THEN ITERATE edloop
      dash=POS('-',firstnum)
      IF dash>0 THEN
        DO
          lastnum=STRIP(SUBSTR(firstnum,dash+1))
          firstnum=STRIP(LEFT(firstnum,dash-1))
        END
      ELSE lastnum=firstnum
      IF ~DATATYPE(firstnum,'N') | ~DATATYPE(lastnum,'N') THEN
        DO
          junk=getinput(1 1 pen3'*** You must enter numbers here! 'def);
          ITERATE edloop
        END
      IF lastnum>lynes.0 THEN lastnum=lynes.0
      IF firstnum<firstedit THEN
        DO
          SAY '*** You are not authorized to delete that line!'CR
          ITERATE edloop
        END
      IF firstnum>lastnum THEN
        DO
          SAY '*** Input error!  First number larger than last number'CR
          ITERATE edloop
        END
      notchanged=0
      numdiff=lastnum+1-firstnum
      pasted.=''
      pasted.0=numdiff
      k=0
      DO i=firstnum TO lynes.0
        j=i+numdiff
        k=k+1
        IF k<=numdiff THEN pasted.k=lynes.i
        lynes.i=lynes.j
        lynes.j=''
      END
      lynes.0=lynes.0-numdiff
    END
  ELSE IF edcom='A' THEN  /* append */
    DO
      CALL writebuffer(scratch'/EditorFile');
      notchanged=0
    END
  ELSE IF edcom='F' THEN  /* fileappend */
    DO
      OPTIONS PROMPT 'Filename: '
      PARSE PULL farg
      IF EXISTS(farg) THEN
        DO
          CALL readlines(farg lynes.0+1);
          notchanged=0
        END
    END
  ELSE IF edcom='I' | edcom='R' | edcom='L' | edcom='P' THEN
    DO
      line=pen3'   '
      IF edcom='L' | edcom='P' THEN line=line'Starting '
      line=line'Line Number? > 'def
      ednum=getinput(1 0 line);
      IF ~DATATYPE(ednum,'N') THEN ITERATE edloop
      IF edcom='L' THEN
        DO
          count=ednum
          ITERATE edloop
        END
      IF ednum<firstedit THEN
        DO
          SAY '*** You are not authorized to alter that line!'CR
          ITERATE edloop
        END
      IF edcom='R' THEN   /* replace */
        DO
          SAY '   Now reads:'CR
          SAY pen3||RIGHT(ednum,2)||def lynes.ednum||CR
          stext=getinput(0 0 pen3'........Search text? >'def);
          IF LENGTH(stext)=0 THEN
            DO
              IF getinput(1 1 lineup||pen3'Replace entire line? (nY) >'def)='N' THEN
                ITERATE edloop
              lynes.ednum=getinput(0 0 pen3||RIGHT(ednum,2)' 'def);
              notchanged=0
              ITERATE edloop
            END
          found=POS(UPPER(stext),UPPER(lynes.ednum))
          IF found=0 THEN
            DO
              SAY stext' was not found!'CR
              ITERATE edloop
            END
          rtext=getinput(0 0 pen3'...Replacement text? >'def);
          lynes.ednum=DELSTR(lynes.ednum,found,LENGTH(stext))
          lynes.ednum=INSERT(rtext,lynes.ednum,found-1)
          SAY 'Done.'CR
          SAY CR
          notchanged=0
        END
      ELSE IF edcom='I' THEN   /* insert */
        DO
          DO i=lynes.0 TO ednum BY -1
            j=i+1
            lynes.j=lynes.i
          END
          lynes.ednum=''
          notchanged=0
          lynes.0=lynes.0+1
          lynes.ednum=getinput(0 0 pen3||RIGHT(ednum,2)'>'def);
        END
      ELSE IF edcom='P' THEN   /* paste */
        DO
          DO i=lynes.0 TO ednum BY -1
            j=i+pasted.0
            lynes.j=lynes.i
          END
          DO k=1 TO pasted.0
            kk=ednum+k-1
            lynes.kk=pasted.k
          END
          notchanged=0
          lynes.0=lynes.0+pasted.0
        END
    END
END
RETURN(0);


editor:
toname=''
msgnum=0
thechosen.=''
PARSE ARG edtype toname msgnum .
IF edtype='MAIL' THEN lastwrit=countcheck(bbspath'Numbers/LastMail 0')
ELSE
  DO
    IF edtype='MSG' THEN
      DO
        tempmsgdir=0
        IF DATATYPE(arg,'N') THEN tempmsgdir=arg
        IF tempmsgdir>0 & tempmsgdir<=level & msg.tempmsgdir~='' THEN
          msgdir=tempmsgdir
        ELSE IF areaselect() THEN RETURN;
      END
    lastwrit=countcheck(bbspath'Numbers/LastMessage'msgdir' 0')
  END
IF toname='' THEN
  DO
    IF edtype='MAIL' THEN
      DO
        CALL selectchosen(1 pen3'Send' edtype lastwrit+1 'To: 'def);
        toname=thechosen.1
      END
    ELSE toname=getinput(1 0 pen3'Post Message To: 'def);
  END
toname=SPACE(toname,1,'_')
toname=COMPRESS(toname,':/*#?^ ')
IF toname='' | FIND(exclusionlist,toname)>0 THEN
  DO
    IF toname='' & edtype='MSG' THEN toname='ALL'
    ELSE toname=sysop
    SAY '                    'lineup||toname'                      'CR
  END
IF toname~='ALL' THEN
  DO
    IF FIND(userlist,toname)=0 | toname='' THEN
      DO
        SAY CR
        SAY bak2' 'toname' is not on the user list! 'def||CR
        IF edtype='MAIL' THEN
          DO
            CALL showuserlist();
            RETURN(0);
          END
        ELSE
          DO
            IF getinput(1 1 'Do you want to use it anyway? (nY) > ')='N' THEN
              DO
                IF getinput(1 1 'Do you want to see the list of current users? (yN) > ')='Y' THEN
                  DO
                    CALL showuserlist();
                    RETURN(0);
                  END
              END
          END
      END
  END
IF edtype='MAIL' THEN
  DO
    CALL MAKEDIR(bbspath'EMail/'toname)
    mailname=bbspath'EMail/'toname'/'name'.'lastwrit+1
  END
ELSE
  DO
    CALL MAKEDIR(msgpath||msgdir)
    mailname=msgpath||msgdir'/'lastwrit+1
  END
lynes.=''
IF edtype='MAIL' THEN lynes.1=' Mail:' lastwrit+1
ELSE lynes.1='  Msg:' lastwrit+1         /*   Msg: MSG# REPLY # # ... */
lynes.2=' From:' name                   /* From: name  FILE: filename */
IF edtype~='MAIL' THEN
  DO
    temp=TRANSLATE(data.3,'         ','+-.*/()<>')
    DO i=WORDS(temp) TO 1 BY -1
      IF DATATYPE(WORD(temp,i),'N') THEN temp=STRIP(DELWORD(temp,i,1))
      IF UPPER(WORD(temp,i))='USA' THEN temp=STRIP(DELWORD(temp,i,1))
    END
    lynes.2=lynes.2' - 'temp           /* if msg, add location (city) */
  END
lynes.3='   To:' toname                        /*  To: toname   MSG # */
subj=''
IF edtype='REPLY' THEN subj=SUBSTR(forthline,WORDINDEX(forthline,2))
ELSE IF edtype='MAIL' & replysubj~='' THEN subj=replysubj
ELSE
  DO
    IF opt='C' THEN subj='FEEDBACK'
    ELSE
      DO
        SAY pen3'Enter the'def 'Subject' pen3'of this message (1 line).'def||CR
        subj=getinput(0 0 pen3': 'def);
      END
  END
lynes.4=' Subj:' subj
lynes.5=' Date:' DATE('W') DATE()'  'TIME('C')
IF edtype~='MAIL' THEN lynes.5=LEFT(lynes.5,39) 'Conference:' msg.msgdir
lynes.6=INSERT('','',1,75,'=')
IF edtype='REPLY' THEN lynes.3=lynes.3'  MSG 'msgnum
DO i=1 TO 6
  SAY lynes.i||CR
END
CALL writebuffer(scratch'/MessageFile');
CALL readlines(scratch'/MessageFile' 7);
CALL seelines();
IF savelines(mailname) THEN RETURN(0);
IF thechosen.0='' THEN
  DO
    thechosen.0=1
    thechosen.1=toname
  END
carbons=thechosen.0+1
DO FOREVER
  pline=''
  IF edtype='MAIL' THEN pline='['pen3'C'def']opies'
  pline=pline '['pen3'E'def']dit ['pen3'K'def']ill ['pen3'R'def']ead'
  pline=pline '['pen3'U'def']pload-Text ['pen3'S'def']end' edtype'? (ekruS) 'def
  junk=getinput(1 1 pline);
  IF junk='E' THEN
    DO
      IF level>sysoplevel THEN firstedit=1
      ELSE firstedit=7
      IF bbsED(firstedit mailname)=2 THEN RETURN(0);
      junk='R'
    END
  ELSE IF edtype='MAIL' & junk='C' THEN
    DO
      CALL selectchosen(carbons pen3'Carbon Copies To: 'def);
      junk='R'
    END
  ELSE IF junk='K' THEN
    DO
      CALL DELETE(mailname)
      SAY edtype 'DELETED.'CR
      RETURN(0);
    END
  ELSE IF junk='U' THEN
    DO
      SAY 'Ready to append' pen3'TEXT ONLY'def 'using'pen3 protocol||def||CR
      pline='Are you SURE your file is un-compressed text? (yN) > '
      IF getinput(1 1 pline)='Y' THEN
        DO
          arg='UploadFile'
          curdir=PRAGMA('D')
          CALL setdir(scratch)
          CALL DELETE(arg)
          CALL DELETE('tempfile1')
          IF uload(0)=0 THEN
            DO
              CALL RENAME(mailname,'tempfile1')
              ADDRESS COMMAND 'join tempfile1 UploadFile AS' mailname
            END
          CALL setdir(curdir)
        END
      junk='R'
    END
  IF junk='R' THEN
    DO
      CALL readlines(mailname 1);
      CALL seelines();
      nonstop=0
    END
  ELSE BREAK;
END
IF edtype='MAIL' THEN
  DO
    IF replysubj~='' & readname~='' & uname~='' THEN
      DO
        junk=getinput(1 1 'Attach original mail from' uname'? (yN) > ');
        IF junk='Y' THEN
          DO
            arg=bbspath'Email/'name'/'readname
            IF ~readlines(arg 1) THEN CALL savelines(mailname);
          END
      END
    junk=getinput(1 1 pen3'Attach a file to this message? (yN) > 'def);
    IF junk='Y' THEN
      DO
        arg=getinput(0 0 'Filename: ')
        curdir=PRAGMA('D')
        CALL MAKEDIR(bbspath'EmailFiles/'toname)
        CALL setdir(bbspath'EmailFiles/'toname)
        IF uload(0)=0 & WORD(STATEF(bbspath'EmailFiles/'toname'/'arg),1)>1 THEN
          DO
            IF arg~='' THEN lynes.2=lynes.2'  FILE: 'arg
            CALL setdir(curdir)
            CALL DELETE(mailname)
            CALL savelines(mailname)
          END
        ELSE
          DO
            CALL DELETE(bbspath'EmailFiles/'toname'/'arg)
            SAY pen3'*** Upload failed! ***'def||CR
          END
      END
  END
IF edtype='MAIL' THEN
  DO
    totmail=WORD(data.17,2)
    IF ~DATATYPE(totmail,'N') THEN totmail=1
    ELSE totmail=totmail+1
    data.17=WORD(data.17,1)'  'totmail'  'WORD(data.17,3)
  END
ELSE totwrit.msgdir=totwrit.msgdir+1
CALL readlines(mailname 1)
DO ui=1 TO thechosen.0
  IF thechosen.ui='' THEN ITERATE ui
  IF ui>1 THEN
    DO
      CALL MAKEDIR(bbspath'Email/'thechosen.ui)
      newname=bbspath'Email/'thechosen.ui'/'name'.'lastwrit+1
      IF ui<carbons THEN lynes.3='   To:' thechosen.ui
      ELSE
        DO
          lynes.1=lynes.1'  (Carbon Copy)'
          lynes.3='   To:' thechosen.1
        END
      CALL savelines(newname)
      IF WORDS(lynes.2)>3 & EXISTS(bbspath'EmailFiles/'thechosen.1'/'WORD(lynes.2,4)) THEN
        DO
          CALL MAKEDIR(bbspath'EmailFiles/'thechosen.ui)
          ADDRESS COMMAND 'COPY' bbspath'EmailFiles/'thechosen.1'/'WORD(lynes.2,4) bbspath'EmailFiles/'thechosen.ui
          line2='Copied' WORD(lynes.2,4)
          SAY line2 'to the' thechosen.ui 'file area.'CR
          CALL send2log(line2)
        END
    END
  line=edtype':'lastwrit+1 'at' TIME('C') 'to' thechosen.ui
  IF edtype~='MAIL' THEN
    DO
      IF FIND(userlist,thechosen.ui)>0 THEN
        CALL msgmark(thechosen.ui msgdir lastwrit+1);
      line=line 'in' msg.msgdir
    END
  CALL send2log(line)
  line=edtype 'Sent To' thechosen.ui
  IF edtype~='MAIL' THEN line=line 'in the' msg.msgdir 'conference.'
  SAY line||CR
END
IF edtype='MAIL' THEN CALL countcheck(bbspath'Numbers/LastMail 'lastwrit+1)
ELSE
  DO
    IF DATATYPE(msg.msgdir.0,'N') THEN msg.msgdir.0=msg.msgdir.0+1
    ELSE msg.msgdir.0=1
    CALL countcheck(bbspath'Numbers/LastMessage'msgdir lastwrit+1)
  END
CALL setdir(libpath||dirs.1);
thechosen.=''
RETURN(1);


msgmark:
PARSE ARG markname markdir markmsg .
IF OPEN(f,bbspath'Users/'markname)=0 THEN RETURN;
mlines.=''
DO mi=1 TO 24
  mlines.mi=READLN(f)
END
mlines.24=STRIP(mlines.24 markdir'/'markmsg)
CALL SEEK(f,0,'B')
DO mi=1 TO 24
  CALL WRITELN(f,mlines.mi)
END
CALL CLOSE(f)
RETURN;


shell:
SAY CR
DO WHILE(UPPER(opt)~='EXIT')
  SAY bak2||TIME('C')||def PRAGMA('D')||CR
  OPTIONS PROMPT pen3'Type EXIT to quit AmigaDOS> 'def
  PARSE PULL opt' 'arg .
  CALL checkdcd();
  IF(UPPER(opt)='CD') THEN CALL setdir(arg)
  ELSE IF exists(opt)~=0 THEN
    DO
      IF left(statef(opt),3)='DIR' THEN CALL setdir(opt)
    END
  ELSE IF opt~='' & UPPER(opt)~='EXIT' THEN
    ADDRESS COMMAND opt '<* >*' arg
END
RETURN;


yell:
IF excuses.1='' THEN
  DO
    IF readopen(bbspath'Lists/Excuses') THEN
      DO
        DO i=1
          line=READLN(f)
          IF EOF(f) THEN BREAK;
          excuses.i=line
        END
        excuses.0=i-1
        CALL CLOSE(f)
      END
  END
j=TIME('S')//excuses.0+1
SAY CR
SAY 'Sorry, your SysOp,' sysop','CR
IF excuses.j~='' THEN SAY excuses.j||CR
ELSE SAY 'is not available.'CR
SAY CR
IF bbsprefs.13 THEN RETURN;
SAY 'I''m yelling anyway... If nobody answers, please try again later.'CR
IF EXISTS(bbspath'BBS_TEXT/YELL.snd') THEN  /* run the sound if its there */
  ADDRESS COMMAND 'Run Sound' bbspath'BBS_TEXT/YELL.snd'
IF SHOWLIST('H','SPEAK') THEN  /* check on SPEAK: device */
  DO
    IF EXISTS(bbspath'BBS_TEXT/YELL') THEN /* we have yell file */
      ADDRESS COMMAND 'Run Type >SPEAK:' bbspath'BBS_TEXT/YELL'
    ELSE                           /* default to SPEAK: */
      DO
        IF writeopen('SPEAK:')=0 THEN RETURN;
        CALL WRITELN(f,'Yo' sysop'.')
        CALL WRITELN(f,'A uzer wants to chat with you.')
        CALL WRITELN(f,'Yo' sysop'.')
        CALL CLOSE(f)
      END
  END
RETURN;


/* online change to member. Sysop triggered by BumpMember.baud */
validate:
IF readopen(bbspath'BBS_TEXT/DEF.MEMBER') THEN
  DO
    SAY CR
    SAY 'You are being auto-validated.  Please wait...'CR
    SAY CR
    DO lvi=1 TO 21
      line=READLN(f)
      IF lvi=11 THEN data.11=line
      IF lvi=20 THEN data.20=line
    END
    data.21=line
    CALL CLOSE(f)
    CALL SetData();
    CALL saveData(0);
  END
ELSE MSG bak2'You need a default member file in BBS_TEXT!   ( BBS_TEXT/DEF.MEMBER )'def
RETURN;


/* online time change. Sysop triggered by BumpTime.baud */
uptime:
mins=GETCLIP('BBS_minutes')
IF DATATYPE(mins,'N') THEN
  DO
    SAY name', this session''s time has been increased to' mins 'minutes.'CR
    maxtime=mins*60
    CALL SETCLIP('BBS_minutes')
  END
RETURN;


/* online level change. Sysop triggered by BumpLevels.baud */
uplevel:
levl=GETCLIP('BBS_level')
IF DATATYPE(levl,'N') THEN
  DO
    SAY name', your level has been changed from' data.20 'to' levl'.'CR
    data.20=levl
    CALL SetData();
    CALL SETCLIP('BBS_level')
    IF menu='NEW' THEN menu='ALL'
    CALL sortlibraries();
  END
RETURN;


/* online ratio change. Sysop triggered by BumpLevels.baud */
upratio:
rats=GETCLIP('BBS_ratio')
IF DATATYPE(rats,'N') THEN
  DO
    SAY name', your upload:download ratio has been changed to 1:'rats'.'CR
    data.17=rats'  'WORD(data.17,2)'  'WORD(data.17,3)
    CALL SETCLIP('BBS_ratio')
  END
RETURN;


edfilenote:
arg=getinput(0 0 pen3'Select File: 'def);
IF EXISTS(arg) THEN
  DO
    ADDRESS COMMAND 'List' arg
    CALL editcomment();
  END
RETURN;


editcomment:
SAY 'Please enter a one-line description of' arg'.'CR
comment=getinput(0 0 pen3': 'def);
IF LENGTH(comment)>77 THEN comment=STRIP(LEFT(comment,77))
IF LENGTH(comment)>0 THEN
  DO
    comment=SPACE(comment,1,'_')
    ADDRESS COMMAND 'filenote' directory'/'arg comment
  END
RETURN;


stats:
ARG indx
bytes='ERROR?'
tfail=0
SetMark 'ErrBlk:'
IF RC~=0 then
  DO
    GetLine
    string=RESULT
    PARSE VAR string .'  ' min':'sec . 'Bytes:'bytes .
    IF DATATYPE(min,'N') & DATATYPE(sec,'N') & DATATYPE(bytes,'N') THEN
      DO
        secs=(min*60)+sec
        temp=STATEF(PRAGMA('D')'/'arg)
        temp=WORD(temp,2)
        IF ~DATATYPE(temp,'N') THEN temp=0
        IF indx=14 & (temp+256)<bytes THEN tfail=1
        IF indx=15 & temp>(bytes+256) THEN tfail=1
        IF ~tfail THEN
          DO
            PARSE VAR data.indx tfiles 'files' tbytes 'bytes.' .
            IF ~DATATYPE(tfiles,'N') THEN tfiles=0
            IF ~DATATYPE(tbytes,'N') THEN tbytes=0
            tbytes=tbytes+bytes
            tfiles=tfiles+1
            IF DATATYPE(secs,'N') THEN
              Say 'Transfer Speed:' TRUNC(bytes/secs+.05,1) 'characters per second.'CR
            IF DATATYPE(WORD(data.indx,1),'N') THEN
                 data.indx=tfiles 'files' tbytes 'bytes.'
            ELSE data.indx='1 files' bytes 'bytes.'
            data.indx=data.indx DATE()
            CALL saveData(0);
          END
      END
    ELSE tfail=1
    IF tfail THEN
      DO
        line=plaindir'/'arg pen3'*** Transfer failed! ***'def
        SAY line||CR
        CALL send2log(line)
        RETURN(1);
      END
    line=left(arg,16,' ')
    IF indx=14 THEN line=line '  uploaded'
    ELSE line=line 'downloaded'
    line=line 'at' TIME('C') bytes 'bytes using' protocol 'in' plaindir'.'
    CALL send2log(line)
  END
RETURN(0);


bbsspace:
ADDRESS COMMAND 'info >ram:infout' bbsdevice
ok=OPEN(f,'ram:infout','R')
IF ok=0 THEN RETURN(20)
line=READLN(f)
line=READLN(f)
line=READLN(f)
line=READLN(f)
CALL CLOSE(f)
SAY CR
bbsk=WORD(line,4)
IF ~DATATYPE(bbsk,'N') THEN
  DO
    line=bbsdevice 'is not an info compatible device!'
    CALL send2log(line)
    SAY pen3||line||def||CR
    bbsk=0
    RETURN;
  END
bbsk=TRUNC(bbsk/2+.5)
SAY RIGHT(bbsk,19)'k available for uploads.'CR
RETURN;


uload:
ARG frommenu
CALL bbsspace();
IF (bbsk*1000)<SYSTEM_SPACE_LIMIT THEN
  DO
    SAY pen3'Upload area is full!'def||CR
    RETURN(1);
  END
IF arg='' THEN arg=getinput(0 0 'Filename: ');   /* no filename given */
IF arg='' THEN RETURN(1);          /* check for filename */
arg=TRANSLATE(arg,'     ',':/,;|')   /* be sure no illegals here */
IF WORDS(arg)>1 THEN arg=STRIP(WORD(arg,1))
IF frommenu THEN
  DO
    SAY 'Please select an appropriate library for' pen3||arg||def'.'CR
    CALL chdir();
  END
filenum=countcheck(bbspath'Numbers/LastFile' 0)
DO ui=1 TO filenum-1 WHILE frommenu
  IF WORD(files.ui,2)=arg THEN
    DO
      temp=WORD(files.ui,1)
      line=pen3'*** File' arg 'already exists here in the'
      line=line temp 'directory.'def
      SAY line||CR
      SAY 'Original uploader may ['pen3'K'def']ill the file before uploading the replacement.'CR
      IF level>sysoplevel & UPPER(plaindir)~=UPPER(temp) THEN LEAVE ui
      ELSE RETURN(1);
    END
END
checkproto='T'
targ=arg
DO WHILE checkproto='T'
  arg=''
  SAY CR
  SAY 'Library:'pen3 plaindir def'  Filename:'pen3 targ def' Protocol:'pen3 protocol||def||CR
  pline=' ['pen3'Q'def']uit ['pen3'T'def']ransfer-protocol'
  pline=pline '['pen3'U'def']pload (qtU) > '
  checkproto=getinput(1 1 pline)
  IF checkproto='Q' THEN RETURN(1);
  IF checkproto='T' THEN CALL chpro();
END
arg=targ
CALL postuser(4);
uploadtime=TIME('E')
SAY 'Starting' protocol 'transfer'CR
DownLoad arg
IF RC>0 | stats(14) THEN RETURN(1);
IF bbsprefs.9 THEN
  DO
    newufile=bbspath'EMail/'sysop'/NEW_FILES'
    IF EXISTS(newufile) THEN ok=OPEN(f,newufile,'A')
    ELSE ok=OPEN(f,newufile,'W')
    IF ok~=0 THEN CALL WRITELN(f,name 'uploaded' plaindir'/'arg'  'DATE() TIME())
    CALL CLOSE(f)
  END
IF POS('EMAILFILES',UPPER(PRAGMA('D')))>0 THEN RETURN(0);
DO ui=sysoplevel+2 TO 100
  IF UPPER(dirs.ui)=UPPER(temp) THEN RETURN(0);
END
IF frommenu THEN
  DO
    uploadtime=TIME('E')-uploadtime
    DO WHILE editnote(PRAGMA('D')'/'arg)  /* INSIST on a filenote */
    END
    IF bbsprefs.11 THEN
      DO
        maxtime=maxtime+uploadtime+60
        line='This session''s time has been increased by'
        line=line TRUNC(uploadtime%60+.05,1)+1 'minutes.'
        SAY CR
        SAY line||CR
      END
    IF bbsprefs.6 THEN   /* need sysop approval */
      DO
        SAY 'Your upload is being placed in the Sysops area for review...'CR
        CALL MAKEDIR(libpath'Sysops')
        CALL MAKEDIR(bbspath'FileNotes/Sysops')
        lastfilenumber=countcheck(bbspath'Numbers/LastFile' 0)
        CALL readlines(bbspath'FileNotes/'plaindir'/'arg 1);
        CALL movefile(lastfilenumber 'Sysops');
      END
  END
RETURN(0);


findfiles:
PARSE ARG ffile
IF ~EXISTS(ffile) THEN
  DO
    nextfilenum=countcheck(bbspath'Numbers/LastFile' 0)+1
    DO ui=1 TO nextfilenum
      argtemp=WORD(files.ui,2)
      IF UPPER(argtemp)=UPPER(ffile) THEN
        DO
          dirtemp=WORD(files.ui,1)
          dirtemp=libpath||dirtemp
          CALL setdir(dirtemp)
          RETURN(0);
        END
      IF ui=nextfilenum THEN
        DO
          SAY '***' ffile 'does not exist!'CR
          RETURN(1);
        END
    END
  END
RETURN(0);


statuscheck:
PARSE ARG ffile
IF level>sysoplevel | POS('EMAILFILES',UPPER(PRAGMA('D')))>0 THEN RETURN(0);
updownratio=WORD(data.17,1)
IF ~DATATYPE(updownratio,'N') THEN updownratio=100
upbytes=WORD(data.14,3)
IF ~DATATYPE(upbytes,'N') THEN upbytes=1
dnbytes=WORD(data.15,3)
IF ~DATATYPE(dnbytes,'N') THEN dnbytes=1
dbytes=WORD(STATEF(ffile),2)
IF ~DATATYPE(dbytes,'N') THEN dbytes=1
IF ~DATATYPE(bps,'N') THEN bps=2400
needtime=dbytes%(bps%10)
SAY CR
SAY 'At least' TRUNC(needtime/60+.05,1) 'minutes needed to download' ffile 'at' bps 'baud.'CR
SAY 'After this transfer your upload:download ratio will be 1:'TRUNC((dbytes+dnbytes)/upbytes)||CR
IF updownloadratio>0 & (dnbytes/upbytes)>updownratio THEN
  DO
    SAY CR
    line=pen3'       *** You must upload before you do any more downloading! ***'def
    SAY line||CR
    CALL send2log('*** Exceeded Download Ratio 1:'TRUNC(dnbytes/upbytes))
    SAY '  Maintain a ratio of at least 1 byte uploaded for each' updownratio 'bytes downloaded.'CR
    IF bbsprefs.4 THEN RETURN(1);
    SAY pen3'             - This requirement is temporarily suspended. -'def||CR
    SAY CR
  END
IF (needtime+TIME('E'))>maxtime THEN
  DO
    SAY CR
    SAY 'Sorry, not enough time left in this session to download' dbytes 'bytes.'CR
    CALL send2log(needtime%60 'mins needed to dl' ffile 'at' dbytes 'bytes!'def)
    IF needtime>(WORD(data.11,1)*60) THEN  /* more than maxtime needed */
      SAY 'Leave email to the sysop to make other arrangements to receive this file.'CR
    SAY CR
    RETURN(1);
  END
RETURN(0);


dload:
errorflag=0
curdir=PRAGMA('D')
OPTIONS PROMPT 'Filenames and/or numbers: '
IF arg='' THEN PARSE PULL arg  /* no filename given */
IF DATATYPE(arg,'N') THEN arg=WORD(files.arg,2)
IF arg='' THEN RETURN;
allargs=TRANSLATE(arg,'     ',':/,;|')
tempargs=allargs
SAY 'Working...'lineup||CR
DO di=1 TO WORDS(tempargs) WHILE STRIP(allargs)~=''
  arg=WORD(tempargs,di)
  IF DATATYPE(arg,'N') THEN
    DO
      wloc=WORDINDEX(allargs,FIND(allargs,arg))
      allargs=DELWORD(allargs,FIND(allargs,arg),1)
      arg=WORD(files.arg,2)
      allargs=INSERT(arg' ',allargs,wloc-1)
    END
  IF findfiles(arg) THEN allargs=DELWORD(allargs,FIND(allargs,arg),1)
END
IF STRIP(allargs)='' THEN RETURN;
sleepy='T'
DO WHILE sleepy='T'
  arg=''
  SAY 'Filename(s)'pen3 allargs def' Protocol:'pen3 protocol||def||CR
  pline=' ['pen3'A'def']uto-Logoff-after-transfer ['pen3'D'def']ownload'
  pline=pline '['pen3'Q'def']uit ['pen3'T'def']ransfer-protocol (aDqt)'
  sleepy=getinput(1 1 pline '> ')
  IF sleepy='Q' THEN RETURN;
  IF sleepy='A' THEN sleepy='LOGOFF'
  IF sleepy='T' THEN CALL chpro();
END
DO WHILE allargs~=''
  arg=STRIP(WORD(allargs,1))
  allargs=STRIP(DELWORD(allargs,1,1))
  DO dloadloop=1
    IF findfiles(arg) | statuscheck(arg) THEN
      DO
        errorflag=1
        LEAVE dloadloop
      END
    CALL checktime();
    CALL postuser(5);
    SAY 'Starting' protocol 'transfer'CR
    UpLoad arg
    IF RC>0 | stats(15) THEN
      DO
        errorflag=1
        LEAVE dloadloop
      END
    IF POS('EMAILFILES',UPPER(PRAGMA('D')))>0 THEN LEAVE dloadloop
    DO di=sysoplevel+2 TO 100
      IF UPPER(dirs.di)=UPPER(plaindir) THEN LEAVE dloadloop
    END
    notename=bbspath'FileNotes/'plaindir'/'arg    /* increment download count */
    IF readlines(notename 1) THEN
      DO
        CALL send2log('Unable to increment download count for' plaindir'/'arg);
        LEAVE dloadloop
      END
    dls=WORD(lynes.2,7)
    IF ~DATATYPE(dls,'N') THEN dls=0
    lynes.2=STRIP(DELWORD(lynes.2,7,1)) dls+1
    CALL DELETE(notename)
    CALL savelines(notename)
    LEAVE dloadloop
  END
  END
CALL setdir(curdir);
IF sleepy='LOGOFF' THEN SIGNAL LOGOUT2
IF errorflag THEN SAY pen3'*** Download Failed!'def||CR
RETURN;


editnote:
IF arg='' THEN
  DO
    PARSE PULL arg .
    IF arg='' | findfiles(arg)>0 THEN RETURN;
  END
slash=LASTPOS('/',arg)
IF slash=0 THEN slash=LASTPOS(':',arg)
IF slash>0 THEN
  DO
    filedir=LEFT(arg,slash-1)
    filedir=SUBSTR(filedir,5)
    arg=SUBSTR(arg,slash+1)
  END
ELSE filedir=plaindir
CALL MAKEDIR(bbspath'FileNotes/'filedir)
IF ~EXISTS(bbspath'FileNotes/'filedir) THEN
  DO
    SAY pen3'*** Failed to open directory!' filedir||def||CR
    RETURN(0);
  END
notename=bbspath'FileNotes/'filedir'/'arg
lynes.=''
filenum=countcheck(bbspath'Numbers/LastFile' 0)
IF level>sysoplevel THEN firstedit=1
ELSE firstedit=5
IF EXISTS(notename) THEN
  DO
    CALL bbsED(firstedit notename);
    RETURN(0);
  END
ELSE
  DO
    filedata=STATEF(libpath||filedir'/'arg)
    IF filedata='' THEN
      DO
        SAY filedir'/'arg 'does not exist!'CR
        RETURN(0);
      END
    bytes=WORD(filedata,2)
    filenum=filenum+1
    lynes.0=4
    lynes.1='File: 'LEFT(filenum,6)'KeyWords:'
    lynes.2='Name: 'LEFT(arg,28)'Size: 'bytes' bytes   Downloads: 0'
    lynes.3='  By: 'LEFT(name,28)'Date: 'DATE() TIME('C')'  Lib: 'filedir
    lynes.4=INSERT('','',1,75,'=')
    SAY 'Please enter a list of keywords to be used by the search routine.'CR
    SAY INSERT('','',1,75,'=')||CR
    templine=getinput(0 0 pen3'              KeyWords: 'def);
    lynes.1=lynes.1 templine
  END
CALL seelines();
CALL writebuffer(scratch'/NoteFile');
CALL readlines(scratch'/NoteFile' 5);
IF savelines(notename) THEN RETURN(0);
fncom='R'
DO WHILE fncom='R'
  line='['pen3'C'def']ancel ['pen3'E'def']dit'
  IF level>sysoplevel THEN line=line '['pen3'K'def']ill'
  line=line '['pen3'R'def']ead ['pen3'S'def']ave'
  IF level>sysoplevel THEN line=line '(cekrS) 'def
  ELSE line=line '(cerS) 'def
  fncom=getinput(1 1 line);
  IF fncom='C' THEN RETURN(1);
  ELSE IF fncom='K' THEN
    DO
      IF level>sysoplevel THEN
        DO
          SAY 'Killing FileNote..'CR
          CALL DELETE(notename)
          RETURN(1);
        END
    END
  ELSE IF fncom='E' THEN
    DO
      IF bbsED(firstedit notename)>0 THEN RETURN(0);
      fncom='R'
    END
  ELSE IF fncom~='R' THEN
    DO
      SAY 'Saving FileNote..'CR
      IF filenum<1 THEN filenum=1
      CALL countcheck(bbspath'Numbers/LastFile' filenum)
      files.0=files.0+1
      files.filenum=plaindir arg
      CALL savefilelist();
      CALL seelines();
      CALL waiting();
      RETURN(0);
    END
  CALL seelines();
  nonstop=0
END
RETURN(0);


savefilelist:
xarg=bbspath'Lists/Files'
IF WORD(STATEF(xarg),1)>5 THEN
  DO
    CALL DELETE(xarg'.BAK')
    CALL RENAME(xarg,xarg'.BAK')
  END
filenum=countcheck(bbspath'Numbers/LastFile' 0)
IF filenum<1 | writeopen(xarg)=0 THEN RETURN(0);
  DO i=1 TO filenum
    IF files.i='' THEN ITERATE
    CALL WRITELN(f,i files.i)
  END
CALL CLOSE(f)
RETURN;


viewuser:
SAY CR
SAY bak2' 'name' 'def||CR
DO i=1 TO 18
  stuff=data.i
  IF i=13 | i=14 THEN stuff=DATE(,data.i,'S')
  SAY RIGHT(i,2)||pen3 text.i||def':' stuff||CR
END
CALL waiting();
RETURN;


edituser:
new=0
change=0
edata.=''
edname=name
DO i=0 TO data.0
  edata.i=data.i
END
num=1
DO WHILE num~='' | edname~=name
  IF num='' THEN
    DO
      IF change THEN
        DO
          CALL SetData();
          CALL saveData(1);
          change=0
        END
      IF new THEN
        DO
          data.=''
          DO i=0 TO edata.0
            data.i=edata.i
          END
          name=edname
          new=0
        END
      CALL SetData();
    END
  maxnum=10
  IF edata.20>sysoplevel THEN maxnum=20
  IF edata.20=99 THEN maxnum=24
  SAY bak2' 'name' 'def||CR
  maxlines=21
  IF maxnum=10 THEN maxlines=20
  DO i=1 TO maxlines
    IF i=5 & name~=edname & edata.20<99 THEN ITERATE;
    SAY RIGHT(i,2)||pen3 text.i||def':' data.i||CR
  END
  IF edata.20>sysoplevel THEN
    DO
      line=LEFT(' ',50)
      IF name=edname THEN line=line'NEW = Change User.'
      line=pen3||line||def||lineup
      SAY line||CR
    END
  num=getinput(1 0 'Select Line Number To Edit: ');
  IF num='NEW' & edata.20>sysoplevel & edname=name THEN    /* select a new user */
    DO
      new=1
      IF change THEN
        DO
          CALL SetData();
          CALL saveData(1)
        END
      change=0
      nufile=bbspath'Email/'sysop'/NEW_USERS'
      IF EXISTS(nufile) THEN
        IF ~readlines(nufile 1) THEN CALL seelines();
      savename=name
      name=getinput(1 0 'New User Name: 'def);
      name=SPACE(name,1,'_')
      name=COMPRESS(name,':/*#?^')
      IF loadData()=0 THEN name=savename
      IF data.20>=edata.20 THEN
        DO
          SAY 'Can''t Edit!' pen3||name def'has an equal or higher level than thee.'
          name=savename
          CALL loadData()
        END
    END
  ELSE IF DATATYPE(num,'N') & num>0 THEN
    DO
      IF num>maxnum THEN
        DO
          SAY CR
          SAY pen3'You are not authorized to change that information!'def||CR
          SAY CR
        END
      ELSE
        DO dummy=1 TO 1
          line=RIGHT(num,2)||pen3 text.num||def': '
          SAY line||data.num||CR
          temp=getinput(0 0 line);
          IF temp='' THEN
            DO
              IF num=1 | num=4 | num=5 | num=6 | num=7 THEN LEAVE dummy;
              IF num=11 | num=12 | num=13 | num=20 THEN LEAVE dummy;
            END
          IF num=5 | num=8 THEN temp=UPPER(temp)
          IF num=20 & DATATYPE(temp,'N') & temp>=edata.20 THEN
            temp=data.20
          IF edata.20>sysoplevel & name~=edname THEN line2=name' '
          ELSE line2=''
          IF num=21 & name=edname & edata.20<99 THEN LEAVE dummy
          line=text.num':' data.num pen6'CHANGED TO'def temp
          CALL send2log(line2||line)
          data.num=temp
          SAY line||CR
          SAY CR
          change=1
        END
    END
END
IF change THEN
  DO
    CALL SetData();
    CALL saveData(1);
  END
RETURN;


getname:
CALL showuserlist();
name=getinput(1 0 'Please enter your Email name : ');
IF name='' THEN
  DO
    SAY 'No name, no entry.  Bye!'CR
    SIGNAL DONE
  END
name=SPACE(name,1,'_')
name=COMPRESS(name,':/*#?^')
IF FIND(userlist,name)>0 | FIND(exclusionlist,name)>0 THEN
  DO
    SAY 'Sorry! That name is taken. Please try again.'CR
    RETURN(1);
  END
RETURN(0);


/** see if name is in data */

checkUser:
tries=0
IF name='NEW' THEN
  DO
    name=''
    DO WHILE getname()
    END
  END
IF FIND(userlist,name)=0 THEN
  DO
    IF EXISTS(bbspath'BBS_TEXT/NEW') THEN
      DO
        CALL readlines(bbspath'BBS_TEXT/NEW' 1);
        CALL seelines();
        CALL waiting();
      END
    SAY CR
    defile=bbspath'BBS_TEXT/DEF.NEW_USER'
    wordnum=FIND(courtesy,name)
    IF wordnum>0 THEN
      DO
        SAY name', is on the Courtesy List. You will be granted immediate access.'CR
        courtesy=STRIP(DELWORD(courtesy,wordnum,1))
        IF writeopen(bbspath'Lists/Courtesy') THEN
          DO
            DO i=1 TO WORDS(courtesy)
              CALL WRITELN(f,WORD(courtesy,i))
            END
            CALL CLOSE(f)
          END
        defile=bbspath'BBS_TEXT/DEF.COURTESY'
      END
    ELSE SAY name', You have new user access.'CR
    IF readlines(defile 1) THEN SIGNAL DONE
    data.=''
    data.0=24
    DO i=6 TO 21
      data.i=lynes.i
    END
    data.12=DATE('S')'  'TIME('C')
    data.13=data.12
    lastondate=DATE('I')-1
    SAY 'Please enter the password you would like to use here.'CR
    data.5=getinput(1 0 'Password: 'pen0);
    IF data.5='' THEN
      DO
        line=def||name 'refused to enter a password.'
        SIGNAL DONE
      END
    data.1=''
    DO WHILE data.1=''
      data.1=getinput(0 0 def'Full Name: ');
      IF data.1='' THEN SAY 'You MUST leave your real name!'CR
    END
    data.2=getinput(0 0 'Street: ');
    data.3=getinput(0 0 'City, State Zip: ');
    data.4=''
    DO WHILE data.4=''
      data.4=getinput(0 0 'Phone: ');
      IF data.4='' THEN
        SAY sysop 'MUST be able to reach you by phone to validate you!'CR
    END
    age=getinput(0 0 'Age: ');
    data.12=data.12'  Age:' age
    IF bbsprefs.8 THEN
      DO
        newufile=bbspath'EMail/'sysop'/NEW_USERS'
        IF EXISTS(newufile) THEN ok=OPEN(f,newufile,'A')
        ELSE ok=OPEN(f,newufile,'W')
        IF ok~=0 THEN CALL WRITELN(f,DATE() TIME() name'='data.1'   'data.4)
        CALL CLOSE(f)
      END
    data.9=getinput(0 0 'Computer: ');
    data.10=getinput(0 0 'Interests: ');
    test=getinput(1 1 pen3'Do you want other users to see your STREET address? (yN) > 'def);
    IF test='Y' THEN data.8=data.8 'STREET'
    test=getinput(1 1 pen3'Do you want other users to see your PHONE number? (yN) > 'def);
    IF test='Y' THEN data.8=data.8 'PHONE'
    SAY CR
    IF data.20=0 THEN
      SAY 'Thank you, the sysop will give you higher access soon.'CR
    SAY 'Please feel free to leave additional info by using [C]omment.'CR
    SAY CR
    CALL SetData();
    CALL saveData(1);
    SAY 'Adding' name 'to the user list...'CR
    newpassword=data.5
    CALL sortuserlist();
  END
ELSE
  DO
    IF loadData()=0 THEN SIGNAL DONE
    PARSE VAR data.11 amins . atimes .
    lastondate=DATE('I',WORD(data.13,1),'S')
    IF DATE('I')>lastondate THEN atimes=3
    IF level>sysoplevel THEN atimes=3
    IF level=99 THEN amins=120
    data.13=DATE('S')'  'TIME()
    data.11=amins 'minutes' atimes-1 'more times today'
    IF atimes<1 & DATE('I')=lastondate THEN
      DO
        SAY CR
        SAY CR
        line= 'Too many calls today.   Call tomorrow.'
        SAY line||CR
        SAY CR
        SAY CR
        CALL send2log(line)
        SIGNAL LOGOUT
      END
    data.13=DATE('S')'  'TIME('C')
    SAY pen3'Password will'def 'NOT' pen3'be echoed.'def||CR
    SAY CR
    passprompt='Enter Password: 'pen0
    DO tries=1 TO 3
      Send passprompt
      Remote OFF
      OPTIONS PROMPT ''
      newpassword=getinput(1 0 '')
      Remote ON
      IF(password=newpassword) THEN
        DO
          SAY def||CR
          LEAVE tries; /* correct password */
        END
      IF(tries=3) THEN
        DO                            /* 3 tries, hang up */
          SAY def||CR
          SAY 'Access terminated.'CR
          line='*** Bad password ***'
          SIGNAL OUT
        END
      SAY def||lineup'                                 'CR
      passprompt='Incorrect.  Password: ' /* ask again */
    END
  END
CALL DELAY(14)
SAY CR
RETURN;


saveData:
ARG messflag .
IF data.5='' THEN RETURN;
SAY 'Updating...'lineup||CR
Status Trans
data.6 = RESULT
IF newfilesdate~='' THEN data.16=lastbrowse newfilesdate
ELSE IF lastbrowse>0 THEN
  DO
    IF WORDS(data.16)>1 THEN data.16=DELWORD(data.16,1,1)
    ELSE data.16=DATE('S') TIME()
    data.16=lastbrowse data.16
  END
IF messflag THEN
  DO
    userexclude.=0
    DO si=1 TO WORDS(data.22)
      IF WORD(data.22,si)=-1 THEN userexclude.si=1
    END
    data.22=''
    data.23=''
    DO si=1 TO level
      IF ~DATATYPE(lastread.si,'N') THEN lastread.si=0
      IF userexclude.si THEN data.22=data.22 '-1'
      ELSE data.22=data.22 lastread.si
      IF ~DATATYPE(totwrit.si,'N') THEN totwrit.si=0
      data.23=data.23 totwrit.si
    END
  END
IF writeopen(bbspath'USERS/'name)=0 THEN RETURN;
IF data.0<24 THEN data.0=24
DO i=1 TO data.0
  CALL WRITELN(f,data.i)
END
CALL CLOSE(f)
SAY 'User file' name 'has been updated.'CR
RETURN;


loadData:
IF name='' THEN RETURN(0);
IF ~readopen(bbspath'USERS/'name) THEN RETURN(0);
data.=''
DO i=1
  line=READLN(f)
  IF EOF(f) THEN BREAK;
  data.i=line
END
data.0=i-1
CALL CLOSE(f)
winnings=WORD(data.18,1)
IF ~DATATYPE(winnings,'N') THEN winnings=0

setData:
IF WORDS(data.16)<3 THEN data.16='0 19900101 00:00:00'
lastbrowse=WORD(data.16,1)
level=data.20
DO i=1 TO level
  lastread.i=WORD(data.22,i)
  IF ~DATATYPE(lastread.i,'N') THEN lastread.i=0
  totwrit.i=WORD(data.23,i)
  IF ~DATATYPE(totwrit.i,'N') THEN totwrit.i=0
END
password=data.5
IF data.6='' THEN
  DO
    Status Trans
    data.6 = RESULT
  END
ELSE Set data.6
linesperpage=data.7
IF FIND(UPPER(data.8),'COLOR')>0 THEN colorflag=1
ELSE colorflag=0
CALL colors(colorflag)
IF FIND(UPPER(data.8),'MENUS')>0 THEN menuflag=1
ELSE menuflag=0
IF FIND(UPPER(data.8),'MENU')>0 THEN
  DO
    menu='ALL'
    menuflag=1
  END
data.21=UPPER(data.21)
maxtime=WORD(data.11,1)*60
RETURN(1);


switchmenuflag:
IF menuflag=1 THEN
  DO
    menuflag=0
    noff='OFF'
  END
ELSE
  DO
    menuflag=1
    noff='ON'
  END
SAY 'Menus turned' pen3||noff||def'.'CR
SAY 'To make a permanent change, add or delete MENU(S) from [Y]our userdata item 8.'CR
RETURN;


switchcolors:
IF colorflag=1 THEN
  DO
    colorflag=0
    noff='OFF'
  END
ELSE
  DO
    colorflag=1
    noff='ON'
  END
CALL colors(colorflag);
SAY 'Color turned' pen3||noff||def'.'CR
SAY 'To make a permanent change, add or delete COLOR from [Y]our userdata item 8.'CR
RETURN;


/* ANSI pen color codes */
colors:
ARG onoff
def=''  /* default */
IF onoff THEN
  DO
    pen0='';  pen1='';  pen2='';  pen3='';
    pen4='';  pen5='';  pen6='';  pen7='';
    bak0='';  bak1='';  bak2='';  bak3='';
    bak4='';  bak5='';  bak6='';  bak7='';
  END
ELSE
  DO
    pen0=''; pen1=''; pen2=''; pen3=''; pen4=''; pen5=''; pen6=''; pen7='';
    bak0=''; bak1=''; bak2=''; bak3=''; bak4=''; bak5=''; bak6=''; bak7=''
  END
RETURN;


chpro:
arg=UPPER(LEFT(arg,1))
IF(arg='') THEN
  DO  /* show protocol menu */
    SAY CR
    SAY '[W]- WXModem'CR
    SAY '[X]- XModem-CRC'CR
    SAY '[K]- XModem-1K'CR
    SAY '[Y]- YModem'CR
    SAY '[G]- YModem-G'CR
    SAY '[Z]- ZModem'CR
    SAY CR
    arg=getinput(1 0 protocol '> ');
 END
Set arg
Status Transfer
protocol = RESULT
SAY protocol||CR
RETURN;


viewtext:
IF arg='' THEN PARSE PULL arg   /* no filename given */
IF arg='' THEN RETURN;
IF level<99 THEN
  arg=COMPRESS(arg,' :/*#?') /* no wildcards, no devs, no dirs allowed */
IF findfiles(arg) THEN RETURN;
CALL showtext(arg);
nonstop=0
RETURN;


information:
infolist=SHOWDIR(bbspath'Information')
IF infolist='' THEN
  DO
    SAY CR
    SAY pen3'No files in' bbspath'Information drawer!'def||CR
    SAY CR
    RETURN;
  END
SAY pen3'These text files are available for reading online...'def||CR
IF ~DATATYPE(sortinfo.0,'N') THEN
  DO
    info.=''
    info.0=WORDS(infolist)
    DO i=1 TO info.0
      info.i=WORD(infolist,i)
    END
    SAY 'Sorting..'CR
    CALL QSORT(1,info.0,info)
    SAY lineup'         'lineup||CR
    sortinfo.=''
    sortinfo.0=info.0%3
    IF (info.0//3)>0 THEN sortinfo.0=sortinfo.0+1
    DO i=1 TO sortinfo.0
      sortinfo.i=''
      DO j=0 TO 2
        k=i+j*sortinfo.0
        IF k<=info.0 THEN sortinfo.i=sortinfo.i RIGHT(k,3)'.' LEFT(info.k,20)
      END
    END
  END
DO FOREVER
  SAY pen3||LEFT('-',75,'-')||def||CR
  DO i=1 TO sortinfo.0
    SAY sortinfo.i||CR
  END
  CALL checktime();
  num=getinput(1 0 pen3'Select Number Of Information File To View> 'def);
  IF ~DATATYPE(num,'N') | num<1 | num>info.0 THEN RETURN;
  CALL readlines(bbspath'Information/'info.num 1);
  CALL seelines();
  IF waitchar~='Q' THEN CALL waiting();
  nonstop=0
END
RETURN;


newfiles:
SAY CR
SAY 'Searching for new (un-browsed) files since' DATE(,WORD(data.16,2),'S') 'at' WORD(data.16,3)'...'CR
SAY pen3' - Use CTRL-E to Exit -'def||CR
lastbrowz=WORD(data.16,1)
lastfileup=countcheck(bbspath'Numbers/LastFile' 0)
j=0
DO ni=lastfileup TO lastbrowz+1 BY -1
  IF files.ni~='' THEN
    DO
      DO ii=level+1 TO sysoplevel
        IF UPPER(dirs.ii)=UPPER(WORD(files.ni,1)) THEN ITERATE ni /* unauthorized */
      END
      j=j+1
      SAY RIGHT(ni,4)'.' LEFT(WORD(files.ni,2),20) pen3':'WORD(files.ni,1)||def||CR
      IF j//linesperpage=0 THEN CALL waiting();
    END
END
IF j//linesperpage~=0 THEN CALL waiting();
CALL newinfo(1);
IF j>0 THEN
  DO
    SAY ' - To reset the ['pen3'N'def']ew files date, you must ['pen3'B'def']rowse at least one file. -'CR
    SAY '      - Use the ['pen3'B'def']rowse command to see file descriptions. -'CR
    CALL waiting();
  END
ELSE SAY 'No new files found in the libraries.'CR
nonstop=0
RETURN;


newinfo:
ARG startinfo .
IF startinfo=1 THEN
  DO
    lynes.=''
    lynes.0=0
  END
IF WORD(STATEF(bbspath'Information'),5)>lastondate THEN
  DO
    lynes.startinfo=pen1||bak2' New or Updated Information Files. Enter'def pen3'I'def bak2'from the main menu to read 'def
    dm=DATE(,WORD(data.16,2),'S')
    PARSE VAR dm da' 'mo' 'yr .
    yr=RIGHT(yr,2)
    sincedate=da'-'mo'-'yr
    ADDRESS COMMAND 'LIST >ram:dirlist' bbspath'Information NOHEAD DATES SINCE' sincedate
    CALL readlines('ram:dirlist' startinfo+1);
  END
IF lynes.0>0 THEN CALL seelines();
nonstop=0
RETURN;


areaselect:
SAY pen3||LEFT('-',75,'-')||def||CR
DO i=1 TO msgs.0
  SAY msgs.i||CR
END
temp=getinput(1 0 pen3'Select Message Conference: 'def);
IF ~DATATYPE(temp,'N') | temp<1 | temp>level | FIND(data.21,temp)>0 THEN RETURN(1);
msgdir=temp
RETURN(0);


chdir:
string=''
SAY pen3||LEFT('-',75,'-')||def||CR
DO i=1 TO libs.0
  SAY libs.i||CR
END
dirnum=getinput(1 0 pen3'Select Library Number: 'def);
IF ~DATATYPE(dirnum,'N') THEN
  DO
    waitchar=dirnum
    RETURN(2);
  END

chdir2:
IF dirnum<1 | dirnum>99 THEN
  DO
    waitchar=dirnum
    RETURN(1);
  END
IF dirs.dirnum='' THEN
  DO
    SAY pen3'That library number in currently un-assigned.'def||CR
    RETURN(1);
  END
IF dirnum>level | FIND(data.21,UPPER(dirs.dirnum))>0 THEN
  DO
    SAY pen3'You do not have authorization for that library!'def||CR
    RETURN(1);
  END
IF dirs.dirnum~='' THEN
  DO
    CALL MAKEDIR(libpath||dirs.dirnum)
    CALL setdir(libpath||dirs.dirnum)
  END
RETURN(0);


since:
IF WORDS(data.16)<3 THEN data.16='0 19900101 00:00:00'
dm=DATE(,WORD(data.16,2),'S')
SAY CR
SAY 'New files since' dm||CR
CALL listsince('')
CALL readlines('RAM:dirlist' 1)
CALL seelines();
nonstop=0
CALL waiting();
RETURN;


listsince:
ARG listarg
IF WORDS(data.16)<3 THEN data.16='0 19900101 00:00:00'
dm=DATE(,WORD(data.16,2),'S')
PARSE VAR dm da' 'mo' 'yr .
yr=RIGHT(yr,2)
sincedate=da'-'mo'-'yr
ADDRESS COMMAND list '>RAM:dirlist' directory listarg 'DATES SINCE' sincedate
RETURN;


list:
onetime=0
IF DATATYPE(arg,'N') THEN onetime=1
ELSE arg=''
DO listloop=1
  IF DATATYPE(arg,'N') THEN
    DO
      dirnum=arg
      arg=''
      IF chdir2()>0 THEN RETURN;
    END
  ELSE IF arg~='' THEN RETURN;
  ELSE IF chdir()>0 THEN RETURN;
  CALL listsimple();
  IF waitchar~='' THEN RETURN;
  IF onetime THEN LEAVE listloop
END
RETURN;


listsimple:
ADDRESS COMMAND list '>RAM:dirlist' directory 'DATES'
IF readlines('RAM:dirlist' 1) THEN RETURN;
IF lynes.0>3 THEN
  DO
    SAY pen3'Sorting...'def||lineup||CR
    linesave=lynes.1  /* these 4 lines put in to leave dir title at top */
    lynes.1='0'
    CALL QSORT(1,lynes.0-1,lynes)
    CALL DELAY(14)
    lynes.1=linesave
  END
CALL seelines();
nonstop=0
CALL waiting();
RETURN;


browse:
curdironly=0
brdir=PRAGMA('D')
brfilenum=1
IF files.0<1 THEN RETURN;
IF arg='' THEN
  DO
    line='Browsing'
    test=getinput(1 1 'Browse the' pen3||plaindir||def 'library only? (yN) > ')
    IF test='Y' THEN
      DO
        curdironly=1
        line=line 'the' pen3||plaindir||def 'library'
      END
    ELSE line=line 'all file libraries'
    line=line 'backwards from latest file.'
    SAY line||CR
  END
lastfilenum=countcheck(bbspath'Numbers/LastFile' 0)
IF lastfilenum<1 THEN RETURN;
i=0
IF arg='' | UPPER(arg)='NEW' | UPPER(arg)='ALL' THEN
  DO
    arg=WORD(files.lastfilenum,2)
    IF arg='' THEN RETURN;
    brfilenum=lastfilenum
  END
ELSE IF DATATYPE(arg,'N') & files.arg~='' THEN
  DO
    brfilenum=arg
    arg=WORD(files.arg,2)
  END
ELSE
  DO
    DO i=1 TO lastfilenum+1
      IF UPPER(WORD(files.i,2))~=UPPER(arg) THEN ITERATE i
      brfilenum=i
      LEAVE i
    END
    IF i>lastfilenum THEN
      DO
        SAY 'Unable to find a file description for' pen3||arg||def'.'CR
        RETURN;
      END
  END
CALL setdir(libpath||WORD(files.brfilenum,1))
savearg=arg
IF brfilenum>lastfilenum THEN brfilenum=lastfilenum
newfilesdate=DATE('S') TIME()
DO browseloop=1
  DO i=brfilenum TO 0 BY -1
    IF files.i='' THEN ITERATE i
    testdir=UPPER(WORD(files.i,1))
    IF curdironly & UPPER(brdir)~=libpath||UPPER(testdir) THEN
      DO
        IF i>lastbrowse THEN lastbrowse=i
        ITERATE i
      END
    IF FIND(data.21,testdir)>0 | finddirnum(testdir)>level THEN
      DO
        IF i>lastbrowse THEN lastbrowse=i
        ITERATE i
      END
    LEAVE i
  END
  IF i=0 THEN brfilenum=lastbrowse;
  ELSE brfilenum=i
  argname=WORD(files.i,2)
  IF argname='' THEN RETURN;
  CALL setdir(libpath||WORD(files.i,1))
  arg=bbspath'FileNotes/'plaindir'/'argname
  CALL readlines(arg 1);
  IF nonstop=1 THEN brostop=1
  ELSE brostop=0
  CALL seelines();
  IF brfilenum>lastbrowse THEN lastbrowse=brfilenum
  CALL checktime();
  IF brostop THEN
    DO
      SAY CR
      nonstop=1
      brfilenum=brfilenum-1
    END
  ELSE
    DO
      line=''
      endtest=UPPER(RIGHT(argname,4))
      line='['pen3'C'def']ontents ['pen3'D'def']ownload'
      line=line '['pen3'H'def']elp ['pen3'N'def']on-Stop'
      IF level>sysoplevel | name=WORD(lynes.3,2) THEN
        line=line '['pen3'E'def']dit ['pen3'K'def']ill'
      IF level>sysoplevel THEN line=line '['pen3'M'def']ove'
      line=line '['pen3'Q'def']uit > '
      brcom=getinput(1 0 line);
      IF DATATYPE(brcom,'N') THEN
        DO
          brfilenum=brcom+1
          SAY CR
        END
      ELSE brcom=LEFT(brcom,1)
      CALL cleanline(0);
      CALL checktime();
      IF brcom='Q' THEN LEAVE browseloop
      ELSE IF brcom='H' THEN
        DO
          SAY pen3' - HELP with the Browse Files commands -'def||CR
          SAY ' RETURN reads the next file description in line.'CR
          SAY ' 34 will display the description of file number 34, if it exists.'CR
          SAY ' C  displays the contents of an archived (lzh|arc|zoo|zip) file.'CR
          SAY ' D  starts sending this file to you using the current protocol.'CR
          IF level>sysoplevel | name=WORD(lynes.3,2) THEN
            DO
          SAY ' E  puts this file description into the online Editor.'CR
          SAY ' K  deletes a file you uploaded. you cannot Kill others!'CR
            END
          IF level>sysoplevel THEN
          SAY ' M  move file and description to new library.'CR
          SAY ' N  displays all descriptions without pausing. CTRL-E to Exit!'CR
          SAY ' Q  returns to the main menu(s). (Quit)'CR
          SAY CR
          CALL waiting();
          IF waitchar='Q' THEN LEAVE browseloop
        END
      ELSE IF brcom='M' THEN
        DO
          mvdir=getinput(0 0 'Move' argname 'to library (name|number) ')
          IF mvdir~='' THEN
            DO
              IF DATATYPE(mvdir,'N') THEN
                DO
                  dirnum=mvdir
                  IF chdir2()=0 THEN
                    CALL movefile(brfilenum dirs.dirnum);
                END
              ELSE
                DO
                  mvdir=STRIP(mvdir)
                  DO mj=1 TO level+1
                    IF UPPER(mvdir)=UPPER(dirs.mj) THEN LEAVE mj
                  END
                  IF mj<=level THEN CALL movefile(brfilenum mvdir)
                END
            END
        END
      ELSE IF brcom='N' THEN
        DO
          brfilenum=brfilenum-1
          nonstop=1
          SAY pen3'To EXIT non-stop scrolling of text, press CTRL-E'def||CR
          SAY CR
          brcom=''
        END
      ELSE IF brcom='C' THEN
        DO
          arcomm='lharc'
          IF endtest='.ARC' THEN arcomm='arc'
          IF endtest='.ZOO' THEN arcomm='zoo'
          IF endtest='.ZIP' THEN
               ADDRESS COMMAND 'unzip >ram:CONTENTS -v' argname
          ELSE ADDRESS COMMAND arcomm '>ram:CONTENTS v' argname
          CALL readlines('RAM:CONTENTS' 1)
          CALL seelines();
          CALL waiting();
          nonstop=0
        END
      ELSE IF brcom='D' THEN
        DO
          arg2=arg
          arg=argname
          CALL dload();
          arg=arg2
        END
      ELSE IF brcom='E' THEN
        DO
          IF level>sysoplevel | name=WORD(lynes.3,2) THEN
            DO
              firstedit=5
              IF level>sysoplevel THEN firstedit=1
              CALL bbsED(firstedit arg);
            END
        END
      ELSE IF brcom='K' THEN
        DO
          IF level>sysoplevel | name=WORD(lynes.3,2) THEN
            DO
              IF getinput(1 1 pen3'Do you really want to kill this file? (nY) >'def)~='N' THEN
                DO
                  tempnum=WORD(lynes.1,2)
                  files.tempnum=''
                  CALL savefilelist();
                  CALL DELETE(argname)
                  CALL DELETE(arg)
                  SAY argname pen3'has been deleted.'def||CR
                END
            END
        END
      ELSE brfilenum=brfilenum-1
    END
END
CALL setdir(brdir)
waitchar=''
IF nonstop THEN CALL waiting();
nonstop=0
CALL savedata(0);
RETURN;


movefile:
PARSE ARG fnum movdir .
fdir=STRIP(WORD(files.fnum,1))
farg=STRIP(WORD(files.fnum,2))
CALL MAKEDIR(libpath||movdir)
ADDRESS COMMAND 'COPY' libpath||fdir'/'farg libpath||movdir
IF EXISTS(libpath||fdir'/'farg) THEN CALL DELETE(libpath||fdir'/'farg)
files.fnum=movdir farg
lynes.3=DELWORD(lynes.3,WORDS(lynes.3),1)
lynes.3=STRIP(lynes.3) movdir
CALL MAKEDIR(bbspath'FileNotes/'movdir)
CALL savelines(bbspath'FileNotes/'movdir'/'farg);
CALL savefilelist();
CALL DELETE(bbspath'FileNotes/'fdir'/'farg)
line='Moved:' fdir'/'farg 'to' movdir
CALL send2log(line);
SAY line||CR
RETURN;


textsearch:
PARSE ARG sfile sarg
x=OPEN(f,sfile,'R')
IF x=0 THEN RETURN(0);
sarg=UPPER(sarg)
stemp=UPPER(READCH(f,65000))
CALL CLOSE(f)
IF POS(sarg,stemp)>0 THEN RETURN(1);
RETURN(0);


bbsSEARCH:
IF menu='ALL' THEN
  DO
    junk=getinput(1 1 'Search ['pen3'F'def']iles ['pen3'M'def']essages or ['pen3'U'def']sers > ')
    IF junk='F' THEN smenu='FILE'
    ELSE IF junk='M' THEN smenu='MSG'
    ELSE IF junk='U' THEN smenu='MAIN'
    ELSE RETURN;
  END
ELSE smenu=menu
searcharg=''
searcharg=getinput(0 0 pen3'Search Phrase: 'def)
IF LENGTH(STRIP(searcharg))=0 THEN RETURN;
searcharg=COMPRESS(searcharg,'*')
CALL send2log('SEARCH:' smenu 'for' searcharg);
lynes.=''
lynes.0=1
IF smenu='NEW' | smenu='MAIN' THEN
  DO
    SAY 'Searching Userlist...'CR
    lynes.1='These user names matched' searcharg'.'
    DO i=1 TO WORDS(userlist)
      IF POS(UPPER(searcharg),UPPER(WORD(userlist,i)))>0 THEN
        DO
          count=lynes.0+1
          lynes.count=WORD(userlist,i)
          lynes.0=count
        END
    END
  END
IF smenu='MSG' THEN
  DO
    SAY 'Searching Message Conferences...'CR
    lynes.1=searcharg 'was found in these messages.'
    DO msgdir=1 TO level
      IF msgdir>level THEN LEAVE msgdir
      IF msg.msgdir='' | FIND(data.21,msgdir)>0 THEN ITERATE msgdir
      msglist=SHOWDIR(msgpath||msgdir)
      IF WORDS(msglist)>0 THEN SAY lineup||RIGHT(msg.msgdir,40)||CR
      DO i=1 TO WORDS(msglist)
        IF textsearch(msgpath||msgdir'/'WORD(msglist,i) searcharg) THEN
          DO
            count=lynes.0+1
            lynes.count='MSG:' RIGHT(WORD(msglist,i),5) 'in' msg.msgdir
            lynes.0=count
          END
      END
    END
  END
IF smenu='FILE' THEN
  DO
    SAY 'Searching File Descriptions...'CR
    lynes.1=searcharg 'was found in the Descriptions of these files.'
    DO i=1 TO countcheck(bbspath'Numbers/LastFile' 0)
      IF files.i='' THEN ITERATE i
      testdir=UPPER(WORD(files.i,1))
      IF FIND(excludelist,testdir)>0 THEN ITERATE i
      IF finddirnum(testdir)>level THEN ITERATE i
      farg=WORD(files.i,1)'/'WORD(files.i,2)
      SAY lineup||RIGHT(farg,40)||CR
      IF textsearch(bbspath'FileNotes/'farg searcharg) THEN
        DO
          SAY lineup||RIGHT(i,5)'.' LEFT(WORD(files.i,2),30) 'Library:' pen3||WORD(files.i,1)||def||CR
          SAY CR
        END
    END
  END
CALL cleanline(0);
IF smenu~='FILE' THEN
  DO
    IF lynes.0<2 THEN
      DO
        SAY lineup'No matches to' searcharg 'were found.'CR
        RETURN;
      END
    CALL seelines();
  END
nonstop=0
CALL waiting();
RETURN;



finddirnum:
ARG fdirname
DO fdir=1 TO 99
  IF UPPER(dirs.fdir)=fdirname THEN RETURN(fdir);
END
RETURN(100);


writebuffer:
PARSE ARG bufname .
CALL DELETE(bufname)
SAY 'Type 'pen3'/END'def' on a new line to exit.'CR
CaptWrap 74
Send pen3
Capture bufname
Send def
DO bufloop=1
  Timeout 90
  Wait '/END'
  Status 'L'
  IF LENGTH(RESULT)=4 THEN LEAVE bufloop
  CALL checkdcd();
END
Timeout maxidle
Send '\b\b\b\b'pen3
Capture OFF
CALL checkdcd();
Queue def||CR
IF bufname=scratch'/EditorFile' THEN startnum=lynes.0+1
ELSE IF bufname=scratch'/MessageFile' THEN startnum=7
ELSE IF bufname=scratch'/NoteFile' THEN startnum=5
ELSE startnum=1
CALL readlines(bufname startnum);
CALL wrapbuf(startnum)
RETURN;


wrapbuf:
CALL cleanline(1);
SAY pen3'Wordwrapping...'def||CR
ARG startnum .
lynes.startnum=COMPRESS(lynes.startnum,'0C'x)  /* no FF */
DO wi=startnum WHILE wi<=lynes.0
  wj=wi+1
  lynes.wj=COMPRESS(lynes.wj,'08'x||'0C'x||'7F'x)
  tabpos=POS('09'x,lynes.wi)
  DO WHILE tabpos>0
    lynes.wi=DELSTR(lynes.wi,tabpos,1)
    lynes.wi=INSERT('  ',lynes.wi,tabpos-1)
    tabpos=POS('09'x,lynes.wi)
  END
  IF LENGTH(lynes.wi)>78 & WORDS(lynes.wi)>1 THEN
    DO
      testchar=''
      IF lynes.wj~='' THEN testchar=LEFT(lynes.wj,1)
      IF testchar=' ' | testchar='.' | testchar='09'x THEN
        DO
          DO wj=lynes.0 TO wi+1 BY -1
            wk=wj+1
            lynes.wk=lynes.wj
          END
          wj=wi+1
          lynes.wj=''
          lynes.0=lynes.0+1
        END
      DO wl=WORDS(lynes.wi) TO 1 BY -1 WHILE LENGTH(lynes.wi)>74
        lynes.wj=WORD(lynes.wi,wl) lynes.wj
        lynes.wi=STRIP(DELWORD(lynes.wi,wl,1))
      END
    END
END
RETURN;


seelines:
DO i=1 TO lynes.0
  IF LEFT(lynes.i,2)=': ' THEN SAY pen2||lynes.i||def||CR
  ELSE IF LEFT(lynes.i,10)='Directory ' | LEFT(lynes.i,5)='=====' THEN
    SAY pen3||lynes.i||def||CR
  ELSE SAY lynes.i||CR
  IF i//linesperpage=0 & nonstop~=1 THEN
    DO
      waitchar=getinput(1 1 pen3'   Q=Quit   N=Non-Stop   RETURN=Continue   'def);
      IF waitchar='N' THEN
        DO
          nonstop=1
          SAY lineup||pen3'To EXIT non-stop scrolling of text, press CTRL-E        'def||CR
          SAY CR
          waitchar=''
        END
      IF waitchar='Q' THEN LEAVE i
      CALL cleanline(1);
      CALL checktime();
    END
END
nonstop=0
RETURN;


readlines:
CALL CLOSE(f)
PARSE ARG tempname readstart .
IF ~readopen(tempname) THEN RETURN(1);
IF readstart<2 THEN lynes.=''
DO ri=readstart
  line=READLN(f)
  IF EOF(f) THEN BREAK;
  lynes.ri=line
END
lynes.0=ri-1
CALL CLOSE(f)
DO ri=lynes.0 TO 0 BY -1 WHILE LENGTH(lynes.ri)=0 | UPPER(lynes.ri)='/END'
END
lynes.0=ri
RETURN(0);


savelines:
PARSE ARG tempname .
IF EXISTS(tempname) & edtype='MAIL' THEN
  DO
    ok=OPEN(f,tempname,'A')
    IF ok~=0 THEN CALL WRITELN(f,INSERT('','',1,75,'^'))
  END
ELSE ok=OPEN(f,tempname,'W')
IF ok=0 THEN
  DO
    line='***' tempname 'failed to open for saving!'
    CALL send2log(line)
    SAY line||CR
    RETURN(1);
  END
DO wi=1 TO lynes.0
  CALL WRITELN(f,lynes.wi)
END
CALL CLOSE(f)
RETURN(0);


loaduserlist:
userlist=SHOWDIR(bbspath'Users')
ulynes.=''
IF ~EXISTS(bbspath'Lists/USERS') THEN CALL sortuserlist();
ELSE IF readopen(bbspath'Lists/USERS') THEN
  DO
    DO i=1
      line=READLN(f)
      IF EOF(f) THEN BREAK;
      ulynes.i=line
    END
    ulynes.0=i-1
    CALL CLOSE(f)
  END
RETURN;


saveuserlist:
IF writeopen(bbspath'Lists/USERS') THEN
  DO
    DO i=1 TO ulynes.0
      CALL WRITELN(f,ulynes.i)
    END
    CALL CLOSE(f)
  END
RETURN;


sortuserlist:
SAY 'Rebuilding Userlist...'CR
userlist=SHOWDIR(bbspath'Users')
user.=''
users=WORDS(userlist)
user.0=users
DO uli=1 TO users
  user.uli=WORD(userlist,uli)
  uscore=LASTPOS('_',user.uli)
  IF uscore>0 THEN user.uli=SUBSTR(user.uli,uscore+1)'@'LEFT(user.uli,uscore-1)
END
CALL QSORT(1,users,user)
DO uli=1 TO users
  uscore=POS('@',user.uli)
  IF uscore>0 THEN user.uli=SUBSTR(user.uli,uscore+1)'_'LEFT(user.uli,uscore-1)
END
ulynes.=''
ulynes.0=user.0%3
IF (user.0//3)>0 THEN ulynes.0=ulynes.0+1
DO i=1 TO ulynes.0
  ulynes.i=LEFT(user.i,25)
  DO j=1 TO 2
    k=i+j*ulynes.0
    IF k<=users THEN ulynes.i=ulynes.i' 'LEFT(user.k,25)
  END
END
CALL saveuserlist();
RETURN;


showuserlist:
IF data.5='' THEN line='Here are the EMail names of your fellow users.'
ELSE line='   'WORDS(userlist) 'users. Use these names to address messages.'
SAY pen3||line||def||CR
DO uli=1 TO ulynes.0
  SAY ulynes.uli||CR
  IF uli//linesperpage=0 & uli<ulynes.0 THEN CALL waiting();
  IF waitchar='Q' THEN RETURN;
END
IF data.5~='' THEN CALL waiting();
RETURN;


msgcount:
ARG countdir .
lastmess=0
IF ~EXISTS(msgpath||countdir) THEN RETURN;
lastread.countdir=WORD(data.22,countdir)
IF ~DATATYPE(lastread.countdir,'N') THEN lastread.countdir=0
IF lastread.countdir<0 THEN RETURN;
lastmess=countcheck(bbspath'Numbers/LastMessage'countdir 0)
firstmess=countcheck(bbspath'Numbers/FirstMessage'countdir 0)
IF lastread.countdir<firstmess THEN lastread.countdir=firstmess-1
IF DATATYPE(msg.countdir.0,'N') THEN totmsgs=msg.countdir.0
totmsgs=lastmess
msg.countdir.0=totmsgs
IF totmsgs<(lastmess-lastread.countdir) THEN totmsgs=lastmess-lastread.countdir
IF lastmess>0 THEN
  IF lastread.countdir>=0 & ~logonflag THEN
    DO
      cline=RIGHT(lastmess-lastread.countdir,6) 'unread of' RIGHT(totmsgs,6)
      cline=cline 'messages in the 'CENTER(msg.countdir,20)' conference.'
      SAY pen6||cline||def||CR
    END
RETURN;


counts:
cmin=countcheck(bbspath'Numbers/Minutes' 0)
chr=cmin%60
cmin=cmin//60
SAY CR
SAY 'Total Connect Time Since First Logon [all users]:' chr 'hours' cmin 'minutes.'CR
prevcaller=GETCLIP('BBS_prevcaller')
IF prevcaller~='' THEN
  DO
    SAY CR
    SAY 'The previous BBS user was' prevcaller||CR
    IF level>sysoplevel THEN
      DO
        SAY '  logged off at:' GETCLIP('BBS_userlogoff')||CR
        SAY pen3'Last disconnect:'def GETCLIP('BBS_disconnect')||CR
      END
  END
ds=DATE()
ds=WORD(ds,2)||WORD(ds,3)
usageclip=GETCLIP('BBS_totalusage')
IF usageclip='' THEN CALL bbsUSAGE.baud(ds)
ELSE
  DO
    SAY CR
    SAY 'Total BBS Usage For' DATE('M') WORD(DATE(),3)':' WORD(usageclip,1) 'hours' WORD(usageclip,2) 'minutes.'CR
  END
CALL bbsspace();
SAY RIGHT(countcheck(bbspath'Numbers/Calls' 0),19)'  completed calls.'CR
SAY RIGHT(countcheck(bbspath'Numbers/LastMail' 0),19)'  private messages.'CR
totmsg=0
DO conf=1 TO 99
  IF msg.conf~='' THEN totmsg=totmsg+countcheck(bbspath'Numbers/LastMessage'conf 0)
END
SAY RIGHT(totmsg,19)'  public messages.'CR
SAY RIGHT(files.0,19)'  public files.'CR
SAY RIGHT(WORDS(userlist),19)'  users.'CR
SAY CR
SAY '  You Have'CR
totmail=WORD(data.17,2)
IF ~DATATYPE(totmail,'N') THEN totmail=0
totmsg=0
DO ti=1 TO level
  temp=WORD(data.23,ti)
  IF DATATYPE(temp,'N') THEN totmsg=totmsg+WORD(data.23,ti)
END
SAY '   Written' RIGHT(totmsg,8) 'public &' RIGHT(totmail,4) 'private  messages.'CR
totfiles=WORD(data.14,1)
IF ~DATATYPE(totfiles,'N') THEN totfiles=0
totbytes=WORD(data.14,3)
IF ~DATATYPE(totbytes,'N') THEN totbytes=0
SAY '  Uploaded' RIGHT(totbytes,8) 'bytes in' RIGHT(totfiles,4) 'files.'CR
totfiles=WORD(data.15,1)
IF ~DATATYPE(totfiles,'N') THEN totfiles=0
totbytes=WORD(data.15,3)
IF ~DATATYPE(totbytes,'N') THEN totbytes=0
SAY 'Downloaded' RIGHT(totbytes,8) 'bytes in' RIGHT(totfiles,4) 'files.'CR
SAY '..and been on' bbsname data.19||CR
SAY CR
CALL waiting();
CALL showmarked();
CALL logonstats();
CALL waiting();
RETURN;


logonstats:
IF level=0 THEN RETURN;
SAY bak2||name||def 'Last on' DATE('W',lastondate,'I') DATE(,lastondate,'I')||CR
lastbrowse=WORD(data.16,1)
IF ~DATATYPE(lastbrowse,'N') THEN lastbrowse=0
tempnum=countcheck(bbspath'Numbers/LastFile' 0)-lastbrowse
IF tempnum>files.0 THEN tempnum=files.0
IF tempnum>0 THEN SAY pen6||RIGHT(tempnum,6) 'new of' RIGHT(files.0,6) 'files.'def||CR
ELSE SAY 'No new files.'CR
totmsg=0
grand=0
DO i=1 TO level
  IF msg.i='' | FIND(data.21,i)>0 THEN ITERATE i
  CALL msgcount(i)
  totmsg=totmsg+lastmess-lastread.i
  grand=grand+lastmess
END
IF totmsg>0 THEN SAY pen6||RIGHT(totmsg,6) 'new of' RIGHT(grand,6) 'messages.'def||CR
ELSE SAY 'No new messages.'CR
IF GETCLIP('BBS_screen')~=0 THEN
  SAY pen3'You may experience slowdowns when the sysop is also using this Amiga.'def||CR
ELSE SAY pen3'BBBBS is in fast mode.'def||CR

callsleft:
test=WORD(data.11,3)
IF test<1 THEN
  line=pen0||bak1' Attention! 'def 'This is your last call for' DATE('W')',' DATE()
ELSE
  DO
    line='You may call' test 'more time'
    IF test~=1 THEN line=line's'
    line=line 'today.'
  END
SAY line||CR
RETURN;


checkdcd:
dcd
IF RC=0 THEN
  DO
    Beep
    CALL DELAY(100)
    dcd
    IF RC=0 THEN
      DO
        CALL SETCLIP('BBS_disconnect',TIME('C') DATE() name)
        line='^^^^^ LOST CARRIER! ^^^' DATE() TIME() '^^^^^'
        SAY CR
        SAY line||CR
        CALL send2log(line)
        Beep
        CALL DELAY(14)
        Beep
        IF newpassword='' THEN SIGNAL DONE
        ELSE SIGNAL OUT
      END
  END
CALL checkexternal();
RETURN;


checkexternal:
xcom=GETCLIP('BBS_COMMAND')
IF xcom~='' THEN
  DO
    CALL SETCLIP('BBS_COMMAND')
    IF POS('G',xcom)>0 THEN SIGNAL LOGOUT2
    IF newpassword~='' THEN
      DO
        IF POS('M',xcom)>0 THEN CALL validate();
        IF POS('L',xcom)>0 THEN CALL uplevel();
        IF POS('T',xcom)>0 THEN CALL uptime();
        IF POS('R',xcom)>0 THEN CALL upratio();
      END
    IF POS('C',xcom)>0 THEN CALL chat();
  END
RETURN;


chat:
SAY 'Entering chat mode with sysop.'CR
SAY 'Press [RETURN] twice to tell' sysop 'you are waiting for a response.'CR
OPTIONS PROMPT ''
string=''
DO WHILE(string~='\')
  PULL string
  CALL checkdcd();
END
RETURN;


readopen:
PARSE ARG fname
ok=OPEN(f,fname,'R')
IF ok~=0 THEN RETURN(1);
line=fname 'failed to open for reading!'
SAY line||CR
CALL send2log(line)
RETURN(0);


writeopen:
PARSE ARG fname
CALL CLOSE(f)
ok=OPEN(f,fname,'W')
IF ok~=0 THEN RETURN(1);
line=fname 'failed to open for writing!'
SAY line||CR
CALL send2log(line)
RETURN(0);


SYNTAX:
FAILURE:
lin.1=pen7||ERRORTEXT(RC)||def
lin.2=SIGL-1     SOURCELINE(SIGL-1)
lin.3=SIGL pen7||SOURCELINE(SIGL)||def
lin.4=SIGL+1     SOURCELINE(SIGL+1)
DO er=1 TO 4
  IF level>sysoplevel THEN SAY lin.er||CR
  CALL send2log(lin.er)
END
CALL CLOSE(f)
IF newpassword='' THEN SIGNAL DONE2  /* no user logged on, quit quietly */
SAY CR
SAY '*** Oops! The BBS was confused for a moment. The sysop will be notified. ***'CR
SAY CR
CALL checkdcd();
IF level>sysoplevel THEN
  DO
    junk=getinput(1 1 'ReStart: (yN) > ');
    IF junk~='Y' THEN SIGNAL LOGOUT
  END
string=''
waitchar=''
IF data.1~='' & data.5~='' & data.20~='' THEN CALL savedata(0);
SIGNAL RESTART


BREAK_E:
Queue CR
CALL CLOSE(f)
SAY pen3'*** CTRL-E BREAK ***'def||CR
waitchar=''
string=''
nonstop=0
rnonstop=0
brostop=0
i=999999
ni=0
RETURN(0);


BREAK_C:
CALL CLOSE(f)
IF newpassword='' THEN
  DO
    CALL SETCLIP('BBS_disconnect',TIME('C') DATE() name)
    SIGNAL DONE2  /* no user logged on, quit quietly */
  END
CALL checkdcd();
Queue CR
IF warnings<1 THEN  /* just 1 warning */
  DO
    warnings=warnings+1
    SAY 'If you didn''t press CTRL-C then...   HEY!    Wake up!'CR
    SAY 'Auto-disconnect in' TRUNC(maxidle%60+.5) 'minutes!'CR
    SAY 'If you DID press CTRL-C, well... never mind!'CR
    Send '^G\w\w^G\w\w^G\w^G\w^G^G^G^G'
    waitchar=''
    string=''
    nonstop=0
    SIGNAL RESTART
  END
CALL SETCLIP('BBS_disconnect',TIME('C') DATE() name)
SAY 'Timeout/Carrier loss -- Disconnecting.'CR
SIGNAL LOGOUT2

LOGOUT:
junk=getinput(1 1 pen3'Leave Feedback for SysOp? (yN) > 'def);
IF junk='Y' THEN
  DO
    opt='C'  /* to trigger Feedback as Subject */
    CALL editor('MAIL' sysop);
  END

LOGOUT2:
CALL callsleft()
secs=TIME('E')
mins=secs%60
secs=TRUNC(secs//60)
IF secs<10 THEN secs='0'secs
SAY
SAY 'Time used this call:' mins':'secs||CR
SAY 'Goodbye' name', thank you for calling' bbsname'.'CR
arg = bbspath'BBS_TEXT/GOODBYE'
IF EXISTS(arg) THEN
  DO
    CALL DELAY(14)
    CALL readlines(arg 1);
    CALL seelines();
  END
SAY CR
IF bbsprefs.2 THEN CALL doGrin();
CALL setdir(libpath||dirs.1)

OUT:
data.18=winnings
line=left(name,16,' ') 'logged off at' time('C')
Remote off
dcd
IF(rc~=0) THEN Send '\ah'
IF data.20~='' THEN
  DO
    Status 'Y'
    elapsed=RESULT
    line=line 'Total:'elapsed
    PARSE VAR elapsed thour':'tmin':'.
    PARSE VAR data.19 dhour 'hours' dmin 'minutes in' calls .
    IF ~DATATYPE(tmin,'N')  THEN tmin=0
    IF ~DATATYPE(thour,'N') THEN thour=0
    IF ~DATATYPE(dhour,'N') THEN dhour=0
    IF ~DATATYPE(dmin,'N')  THEN dmin=0
    IF ~DATATYPE(calls,'N') THEN calls=0
    IF thour=0 & tmin<3 THEN            /* free call if less than 3 minutes */
      DO
        wordloc=WORDINDEX(data.11,3)-1
        wordval=WORD(data.11,3)+1
        data.11=DELWORD(data.11,3,1)
        data.11=INSERT(wordval' ',data.11,wordloc)
      END
    mins=thour*60+tmin+countcheck(bbspath'Numbers/Minutes' 0)
    cals=countcheck(bbspath'Numbers/Calls' 0)+1
    CALL countcheck(bbspath'Numbers/Minutes' mins);
    CALL countcheck(bbspath'Numbers/Calls' cals);
    thour=thour+dhour
    tmin=tmin+dmin+1
    IF tmin>59 THEN
      DO
        thour=thour+tmin%60
        tmin=tmin//60
      END
    data.19=thour 'hours' tmin 'minutes in' calls+1 'calls.'
    CALL SETCLIP('BBS_elapsed',elapsed)
    CALL SETCLIP('BBS_userlogoff',TIME('C') DATE())
    CALL postuser(6);
    ADDRESS AREXX bbsUSAGE.baud
    CALL saveData(1)
  END

OUT2:
CALL send2log(line);

DONE:
CALL send2log('')

DONE2:
Remote OFF
dcd
IF RC~=0 THEN Send '\ah'
baud maxbps
Data startdir
Set F
CALL SETCLIP('BBS_level')
CALL SETCLIP('BBS_minutes')
Send 'ATZ\r'  /* reset modem */
EXIT;


getbaudrate: PROCEDURE
TRACE OFF
BaudRate
brate=RC
TRACE
RETURN(brate);


/* end of BBBBS.baud */


/*-------  Userfile Data definition  ---  v=view  e=edit ----------------*/

ve  1 name
ve  2 address
ve  3 city state country zip
ve  4 telephone
ve  5 password
ve  6 protocol
ve  7 lines per page
ve  8 Preferences: MENUS COLOR STREET PHONE etc. On list=YES, ON or PUBLIC.
ve  9 Computer model
ve 10 interests        ! SYSOP edit only below this line !
v  11 nn minutes n more times today  (typically 60 mins 3 times/day).
v  12 first date on.  timestamp  age
v  13 last  date on BBS in 'S' form for rexx DATE().
v  14 uploaded files bytes lastdate
v  15 downloaded files bytes lastdate
v  16 lastfilebrowsed lastfilelistdate lastfilelisttime
v  17 ul:dl_ratio  total_email_written
v  18 winnings
v  19 total time on this BBS in hours minutes calls
v  20 level
   21 exclude dirs by name (conferences by number), separated by spaces.
   22 oldest messages read
   23 total msgs written per conference

/* end data defines */